(* Yoann Padioleau
 *
 * Copyright (C) 2019-2024 Semgrep Inc.
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public License
 * version 2.1 as published by the Free Software Foundation, with the
 * special exception on linking described in file LICENSE.
 *
 * This library is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the file
 * LICENSE for more details.
 *)
open Common

(* G is the pattern, and B the concrete source code.
 * You might be tempted to just open AST_generic and get rid of G and B,
 * but it's easy to be confused on what is a pattern and what is the target,
 * so at least using different G and B helps a bit.
 *
 * subtle: use 'b' to report errors, because 'a' is the pattern.
 *)
module G = AST_generic
module B = AST_generic
module MV = Metavariable
module Options = Rule_options_t
module H = AST_generic_helpers
open Matching_generic
module Log = Log_matching.Log

let hook_find_possible_parents = ref None
let hook_r2c_pro_was_here = ref None

(*****************************************************************************)
(* Prelude *)
(*****************************************************************************)
(* AST generic vs AST generic code matcher.
 *
 * This module allows to match some AST elements against other AST elements in
 * a flexible way, providing a kind of grep but at a syntactical level.
 *
 * Most of the boilerplate code was generated by code in pfff
 *    $ meta/gen_code -matcher_gen_all
 * using OCaml pad-style reflection (see commons/OCaml.ml) on
 * h_program-lang/AST_generic.ml.
 *
 * See pfff matcher/fuzzy_vs_fuzzy.ml for another approach.
 *
 * There are four main features allowing a "pattern" to match some "code":
 *  - metavariables can match anything (see metavar: tag in this file)
 *  - '...' can match any sequence (see dots: tag)
 *  - simple constructs match complex constructs having more details
 *    (e.g., the absence of attribute in a pattern will still match functions
 *     having many attributes) (see less-is-ok: tag)
 *  - the underlying AST uses some normalization (!= is transformed in !(..=))
 *    to support certain code equivalences (see equivalence: tag)
 *  - we do not care about differences in spaces/indentations/comments.
 *    we work at the AST-level.
 *  - other equivalences using global analysis (see deep: tag)
 *
 * alternatives:
 *  - would it be simpler to work on a simpler AST, like a Term language,
 *    or even a Node/Leaf? or Ast_fuzzy? the "less-is-ok" would be
 *    difficult with that approach, because you need to know that some
 *    parts of the AST are attributes/annotations that can be skipped.
 *    In the same way, code equivalences like name resolution on the AST
 *    would be more difficult with an untyped-general tree.
 *)

(*****************************************************************************)
(* Extra Helpers *)
(*****************************************************************************)

let env_add_matched_stmt rightmost_stmt (tin : tin) =
  [ extend_stmts_matched rightmost_stmt tin ]

(* equivalence: on different indentation
 * todo? work? was copy-pasted from XHP sgrep matcher
 *)
let m_string_xhp_text sa sb =
  if sa = sb || (sa =~ "^[\n ]+$" && sb =~ "^[\n ]+$") then return ()
  else fail ()

let has_ellipsis_and_filter_ellipsis_gen f xs =
  let has_ellipsis = ref false in
  let ys =
    xs
    |> List_.exclude (fun x ->
           let res = f x in
           if res then has_ellipsis := true;
           res)
  in
  (!has_ellipsis, ys)

let has_ellipsis_and_filter_ellipsis xs =
  has_ellipsis_and_filter_ellipsis_gen
    (function
      | { G.e = G.Ellipsis _; _ } -> true
      | _ -> false)
    xs

let rec obj_and_dot_accesses_of_expr e =
  match e.G.e with
  | B.Call ({ e = B.DotAccess (e, tok, fld); _ }, args) ->
      let o, xs = obj_and_dot_accesses_of_expr e in
      (o, (fld, tok, Some args) :: xs)
  | B.DotAccess (e, tok, fld) ->
      let o, xs = obj_and_dot_accesses_of_expr e in
      (o, (fld, tok, None) :: xs)
  | _ -> (e, [])

let rec expr_of_obj_and_dot_accesses (obj, xs) =
  match xs with
  | [] -> obj
  | (fld, tok, Some args) :: xs ->
      let e = expr_of_obj_and_dot_accesses (obj, xs) in
      B.Call (B.DotAccess (e, tok, fld) |> G.e, args) |> G.e
  | (fld, tok, None) :: xs ->
      let e = expr_of_obj_and_dot_accesses (obj, xs) in
      B.DotAccess (e, tok, fld) |> G.e

let rec all_suffix_of_list xs =
  xs
  ::
  (match xs with
  | [] -> []
  | _x :: xs -> all_suffix_of_list xs)

(* let _ =
     Common2.example
       (all_suffix_of_list [ 1; 2; 3 ] =*= [ [ 1; 2; 3 ]; [ 2; 3 ]; [ 3 ]; [] ]) *)

(* copy paste of module_ml.ml *)
let module_name_of_filename file =
  let _d, b, _e = Filename_.dbe_of_filename file in
  let module_name = String.capitalize_ascii b in
  module_name

(* Should `$X(...)` match a call to an IdSpecial function? *)
let should_match_call = function
  (* e.g. `this()` in Java constructors *)
  | G.This
  (* e.g. `super()` in JS constructor. Should be Java too, but Java doesn't use
   * IdSpecial for super calls *)
  | G.Super
  | G.Self
  | G.Parent
  (* JS `require("fs")` *)
  | G.Require
  | G.Eval ->
      true
  | G.Typeof
  | G.Instanceof
  | G.Sizeof
  | G.NextArrayIndex
  | G.Defined
  | G.ConcatString _
  | G.EncodedString _
  | G.InterpolatedElement
  | G.Spread
  | G.HashSplat
  | G.ForOf
  | G.Op _
  | G.IncrDecr _ ->
      false

let m_id_string case_insensitive =
  if case_insensitive then fun a b ->
    m_string (String.lowercase_ascii a) (String.lowercase_ascii b)
  else m_string

(*****************************************************************************)
(* Name *)
(*****************************************************************************)

(* coupling: modify also m_ident_and_id_info *)
(* You should prefer to use m_ident_and_id_info if you can *)
let m_ident a b =
  match (a, b) with
  (* metavar: *)
  | (str, tok), b when Mvar.is_metavar_name str ->
      envf (str, tok) (MV.Id (b, None))
  (* in some languages such as Javascript certain entities like
   * fields can use strings for identifiers (e.g., {"myfield": 1}),
   * which gives the opportunity to use regexp string for fields
   * (e.g., {"=~/.*field/": $X}).
   *)
  | (stra, _), (strb, _) when Pattern.is_regexp_string stra ->
      let re_match = Matching_generic.regexp_matcher_of_regexp_string stra in
      if re_match strb then return () else fail ()
  (* Note: We should try to avoid allowing case insensitive
   *  identifiers to get here because we have no way of
   *  distinguishing them from case sensitive identifiers
   *)
  (* general case *)
  | a, b -> m_wrap m_string a b

(* see also m_dotted_name_prefix_ok *)
let m_dotted_name a b =
  match (a, b) with
  (* $X should match any list *)
  | [ (s, t) ], b when Mvar.is_metavar_name s ->
      envf (s, t) (MV.N (H.name_of_ids b))
  (* TODO? we could allow a.b.$X to match a.b.c.d *)
  | a, b -> (m_list m_ident) a b

(* OPT: As an optimization, all locations that require empty_id_infos reuse this
 * reference to cut down on allocations.
 *
 * Profiling showed that allocations generated by `empty_id_info ()` in this file
 * were a sizeable portion of some traces' major heap!
 *
 * see: https://github.com/semgrep/semgrep-proprietary/pull/2302
 *
 * WARNING: NOTE: this invalidates an important invariant in our AST, that each
 * identifier has a unique/fresh refrence to an id_info. Although we are able
 * to get by with a weaker set of invariants for this file, we should not
 * sacrifice this invariant
 *
 * TODO: refactor `make_dotted` & `m_expr` to not require empty id_infos at all,
 * bypassing the need for this optimization.
 *)
let static_empty_id_info = B.empty_id_info ()

(* This is for languages like Python where foo.arg.func is not parsed
 * as a qualified name but as a chain of DotAccess.
 *
 * WARNING: NOTE: While the dotted identifiers are of the correct type, they all
 * share the same id_info and can't be used in general to modify id_info fields;
 * we strictly only use them for matching. This function is not exported, so
 * we've only reasoned about local calls.
 *)
let make_dotted xs =
  match xs with
  | [] -> raise Impossible
  | x :: xs ->
      let base = B.N (B.Id (x, static_empty_id_info)) |> G.e in
      List.fold_left
        (fun acc e ->
          let tok = Tok.fake_tok (snd x) "." in
          B.DotAccess (acc, tok, B.FN (B.Id (e, static_empty_id_info))) |> G.e)
        base xs

(* similar to m_list_prefix but binding $X to the whole list *)
let rec m_dotted_name_prefix_ok a b =
  match (a, b) with
  | [], [] -> return ()
  | [ (s, t) ], [ x ] when Mvar.is_metavar_name s ->
      envf (s, t) (MV.Id (x, None))
  | [ (s, t) ], _ :: _ when Mvar.is_metavar_name s ->
      (* TODO: should we bind it instead to a MV.N IdQualified?
       * but it is actually just the qualifier part; the last id
       * is not here (even though make_dottd will not care about that)
       *)
      envf (s, t) (MV.E (make_dotted b))
  | xa :: aas, xb :: bbs ->
      let* () = m_ident xa xb in
      m_dotted_name_prefix_ok aas bbs
  (* prefix is ok *)
  | [], _ -> return ()
  | _ :: _, _ -> fail ()

(* less-is-ok: prefix matching is supported for imports, eg.:
 *  pattern: import foo.x should match: from foo.x.z.y
 *)
let m_module_name_prefix a b =
  match (a, b) with
  (* dots: '...' on string or regexp *)
  | G.FileName a, B.FileName b ->
      m_string_ellipsis_or_metavar_or_default
      (* TODO figure out what prefix support means here *)
        ~m_string_for_default:m_filepath_prefix a b
  | G.DottedName a1, B.DottedName b1 -> m_dotted_name_prefix_ok a1 b1
  | G.FileName _, _
  | G.DottedName _, _ ->
      fail ()

let m_module_name a b =
  match (a, b) with
  | G.FileName a1, B.FileName b1 -> (m_wrap m_string) a1 b1
  | G.DottedName a1, B.DottedName b1 -> m_dotted_name a1 b1
  | G.FileName _, _
  | G.DottedName _, _ ->
      fail ()

(* Supports deep expression matching, either when done explicitly
 * (e.g. with deep ellipsis) or implicitly.
 *
 * If "go_deeper_expr" is not enabled, reduces to `first_fun a b`.
 * If "go_deeper_expr" is enabled, will first run `first_fun a b`, and then
 * will match against all sub-expressions of b.
 *
 * See m_expr_deep for an example of usage.
 *
 * deep_fun: Matching function to use when matching sub-expressions
 * first_fun: Matching function to use when matching the whole (top-level)
 * expression
 * sub_fun: Function to use to extract sub-expressions from b
 * a: Pattern expression
 * b: Target node
 * 't: Type of the target node
 *
 * todo? now that we don't use >!> and always explore the subexprs,
 * we could probably refactor this code to not need so many arguments.
 *)
let m_deep (deep_fun : G.expr Matching_generic.matcher)
    (first_fun : G.expr -> 't -> tin -> tout) (sub_fun : 't -> G.expr list)
    (a : G.expr) (b : 't) =
  if_config
    (fun x -> not x.go_deeper_expr)
    ~then_:(first_fun a b)
    ~else_:
      (* bugfix: this used to be a >!> below, but this does not work! We need
       * to also explore subexprs, whatever the result of 'first_fun a b'.
       * Indeed, if the deep pattern was <... $X ...>, $X will always
       * match (unless it was bound before), but we actually need to
       * enumerate all possible subexprs and make $X bind to all
       * possibles subexprs.
       *)
      (first_fun a b
      >||>
      (* less: could use a fold *)
      let rec aux xs =
        match xs with
        | [] -> fail ()
        | x :: xs -> deep_fun a x >||> aux xs
      in
      b |> sub_fun |> aux)

(* In Match_patterns.match_rules_and_recurse we create a new env for each attempt
 * at matching a "mini-rule" against a sub-AST, so this bound doesn't need to be
 * large. Our test suite only needs it to be >= 3 to pass! *)
let max_NESTED_SYMBOLIC_PROPAGATION = 50

let m_with_symbolic_propagation ~is_root f b tin =
  if
    (* If we are not at the root, then we permit recursing into substituted values. *)
    tin.config.Options.constant_propagation
    && tin.config.Options.symbolic_propagation && not is_root
  then
    (* In the past, naming bugs have introduced circular references causing
     * infinite loops, and not all are caught by the defensive check `b1 == b`
     * below. We enforce a bound just to make sure that we never hang due to
     * one of these bugs. *)
    if tin.deref_sym_vals < max_NESTED_SYMBOLIC_PROPAGATION then
      match b.G.e with
      | G.N (G.Id ((id, _), { id_svalue = { contents = Some (G.Sym b1) }; _ }))
        ->
          (* We shouldn't end up with a symbol that resolves to itself, but if
           * we do, we shouldn't crash. This simple check will not protect
           * against complicated paths through which a symbol could resolve to
           * itself, but if it directly resolves to itself, we can easily catch
           * it. *)
          if phys_equal b1 b then (
            Log.warn (fun m ->
                m
                  "Aborting symbolic propagation: Circular reference \
                   encountered (\"%s\")"
                  id);
            fail () tin)
          else f b1 { tin with deref_sym_vals = tin.deref_sym_vals + 1 }
      | ___else___ -> fail () tin
    else (
      Log.warn (fun m ->
          m
            "Aborting symbolic propagation: a bug in Semgrep may be causing an \
             infinite loop");
      fail () tin)
  else fail () tin

(* Match regexp matching options such as 'i' in '/a*/i' *)
let m_regexp_options a_opt b_opt =
  match (a_opt, b_opt) with
  (* less_is_ok: *)
  | None, _ -> return ()
  | Some a, Some b -> m_ellipsis_or_metavar_or_string a b
  | Some _, None -> fail ()

(* start of recursive need *)
(* TODO: factorize with metavariable and aliasing logic in m_expr
 * TODO: remove MV.Id and use always MV.N?
 *)
let rec m_name_inner a b =
  (* Inside of this function, any recursive call to m_name means to not
     start another round of entry-specific logic. We only recurse with
     the inner m_name function.
  *)
  let m_name = m_name_inner in
  let try_parents dotted =
    let parents =
      match !hook_find_possible_parents with
      | None -> []
      | Some f -> f dotted
    in
    (* less: use a fold *)
    let rec aux xs =
      match xs with
      | [] -> fail ()
      | x :: xs -> m_name a x >||> aux xs
    in
    aux parents
  in
  let try_alternate_names idb resolved =
    let _, tidb = idb in
    match resolved with
    | B.GlobalName (_, alternate_names) ->
        List.fold_left
          (fun acc alternate_name ->
            let dotted = G.canonical_to_dotted tidb alternate_name in
            acc >||> m_name a (H.name_of_ids dotted))
          (fail ()) alternate_names
    | _ -> fail ()
  in
  let try_with_equivalences a b =
    (* equivalence: aliasing (name resolving) part 1 *)
    match (a, b) with
    | ( a,
        B.Id
          ( idb,
            ({
               B.id_resolved =
                 {
                   contents =
                     Some
                       ( (( B.ImportedEntity canonical
                          | B.ImportedModule canonical
                          | B.GlobalName (canonical, _) ) as resolved),
                         _sid );
                 };
               _;
             } as infob) ) ) ->
        let dotted = G.canonical_to_dotted (snd idb) canonical in
        (* coupling: resolved names with wildcards *)
        wipe_wildcard_imports
          (m_name a (B.Id (idb, { infob with B.id_resolved = ref None }))
          >||> try_alternate_names idb resolved
          (* Try the resolved entity *)
          >||> m_name a (H.name_of_ids dotted)
          >||>
          (* Try the resolved entity and parents *)
          match a with
          (* > If we're matching against a metavariable, don't bother checking
           * > the resolved entity or parents. It will only cause duplicate matches
           * > that can't be deduped, since the captured metavariable will be
           * > different.
           *
           * FIXME:
           * This is actually not the correct way of dealing with the problem,
           * because there could be `metavariable-xyz` operators filtering the
           * potential values of the metavariable. See DeepSemgrep commit
           *
           *     5b2766ee30e "test: Tests for matching metavariable patterns against resolved names"
           *)
          | G.Id ((str, _tok), _info) when Mvar.is_metavar_name str -> fail ()
          | _ ->
              (* Try matching against parent classes *)
              try_parents dotted)
    | __else__ -> fail ()
  in
  match (a, b) with
  (* old: Previously we applied the equivalences in 'try_with_equivalences' right
   *      here. The good was that we handled equivalences first of all and they did
   *      not have to be taken into consideration anywhere else. The bad was that
   *      applying the equivalences erases the 'id_info', and when $MVARs bound to
   *      global identifiers, we had lost all that valuable info. *)
  | G.Id (a1, a2), B.Id (b1, b2) ->
      (* this will handle metavariables in Id *)
      m_ident_and_id_info (a1, a2) (b1, b2) >!> fun () ->
      try_with_equivalences a b
  | G.Id ((str, tok), _info), G.IdQualified _ when Mvar.is_metavar_name str ->
      envf (str, tok) (MV.N b)
  (* equivalence: aliasing (name resolving) part 2 (mostly for OCaml) *)
  | ( G.IdQualified _a1,
      B.IdQualified
        ({
           name_last = idb, _;
           name_info =
             {
               B.id_resolved =
                 {
                   contents =
                     Some
                       ( (( B.ImportedEntity canonical
                          | B.GlobalName (canonical, _) ) as resolved),
                         _sid );
                 };
               _;
             };
           _;
         } as nameinfo) ) ->
      (* TODO? use all the tokens in b1? not just idb? *)
      let dotted = G.canonical_to_dotted (snd idb) canonical in
      (* coupling: resolved names with wildcards *)
      wipe_wildcard_imports
        (try_parents dotted
        >||> try_alternate_names idb resolved
        (* try without resolving anything *)
        >||> m_name a
               (B.IdQualified { nameinfo with name_info = static_empty_id_info })
        >||>
        (* try this time by replacing the qualifier by the resolved one *)
        let new_qualifier =
          match List.rev dotted with
          | [] -> raise Impossible
          | _x :: xs -> List.rev xs |> List_.map (fun id -> (id, None))
        in
        let new_middle =
          match new_qualifier with
          | [] -> None
          | xs -> Some (B.QDots xs)
        in
        m_name a
          (B.IdQualified
             {
               nameinfo with
               name_middle = new_middle;
               name_info = static_empty_id_info;
             }))
  (* semantic! try to handle open in OCaml by querying LSP! The
   * target code is using an unqualified Id possibly because of some open!
   *)
  | G.IdQualified { name_last = ida, None; _ }, B.Id (idb, _infob)
    when fst ida = fst idb -> (
      match !Hooks.get_def idb with
      | None -> try_with_equivalences a b
      | Some file ->
          let m = module_name_of_filename file in
          let t = snd idb in
          let _n = H.name_of_ids [ (m, t); idb ] in
          (* retry with qualified target *)
          (* m_name a n *)
          return ())
  (* boilerplate *)
  | ( _a1,
      G.IdQualified
        ({
           name_last = idb, _;
           name_info =
             {
               B.id_resolved =
                 {
                   contents =
                     Some
                       ( (( B.ImportedEntity canonical
                          | B.ImportedModule canonical
                          | B.GlobalName (canonical, _) ) as resolved),
                         _sid );
                 };
               _;
             };
           _;
         } as b1) ) ->
      (* TODO? use all the tokens in the name? not just idb? *)
      let dotted = G.canonical_to_dotted (snd idb) canonical in
      (* coupling: resolved names with wildcards *)
      wipe_wildcard_imports
        (try_parents dotted
        >||> try_alternate_names idb resolved
        >||>
        match a with
        | IdQualified a1 -> m_name_info a1 b1
        | Id _ -> fail ())
  | G.IdQualified a1, B.IdQualified b1 -> m_name_info a1 b1
  | G.Id _, _
  | G.IdQualified _, _ ->
      try_with_equivalences a b

(* This is just an entry point for m_name_inner, which just ensures that we only
   ever unpack wildcard imports once, before entering the main recursive loop of
   m_name_inner.
   Since we might reach m_name through many entry points (IdQualified,
   DotAccess, Id, etc), it's easier to intercept all of these "naming-related"
   matching procedures at a common point. This is where they all meet.
*)
and m_name a b =
  let dotted_contains_mvars dotted =
    List.exists (fun (s, _) -> Mvar.is_metavar_name s) dotted
  in
  let dotted_b = H.dotted_ident_of_name b in
  m_name_inner a b >!> fun () tin ->
  match (b, dotted_b) with
  (* If we are matching with a pattern that has a metavariable in it,
     let's not unpack the wildcard import.

     Usually, someone wants a wildcard import to activate when they know the full path
     of the thing they want to match, e.g. A.B.C.foo. But if they write a pattern like
     $X.$Y, this will suddenly start to match every single identifier that lies under
     a wildcard import, which is potentially dangerous.
  *)
  | _ when dotted_contains_mvars (H.dotted_ident_of_name a) -> fail () tin
  (* coupling: resolved names with wildcards
     If the name we are trying to match has a resolved name, then its
     "true name" is something which we already know. We don't need to patch it
     with the information from wildcard imports to try and match it.

     This also means that any time in matching that we find ourselves matching
     something with a resolved name, we have to ensure any future calls to
     `m_name` do not unpack wildcard imports. This case here is insufficient,
     because for instance if we were matching `B.foo` to `foo` with a resolved
     name of `A.foo`, one valid code path is to try and match `foo` with no
     resolved name.

     This will cause the wildcard import logic to trigger, despite the fact
     that this `foo` identifier had a resolved name, because we got rid of it.
     So anywhere we decompose on an `ImportedEntity` or similar, we should wipe
     wildcard imports from `tin` to prevent this case.
  *)
  (* For this case, we can just fail here, because this will be taken care of by
     the main `m_name_inner` call.
  *)
  | ( Id
        ( _,
          {
            id_resolved =
              {
                contents =
                  Some ((GlobalName _ | ImportedEntity _ | ImportedModule _), _);
              };
            _;
          } ),
      _ ) ->
      fail () tin
  | _ ->
      List.fold_left
        (fun acc import ->
          acc
          >||>
          (* By precondition, the pattern should not have any metavariables in it, meaning
             that the location data of the imports we are inserting should not matter.
          *)
          let import_with_fake_location =
            List_.map (fun (s, _) -> (s, G.fake "")) import
          in
          let b_ids = import_with_fake_location @ dotted_b in
          m_name_inner a (H.name_of_ids b_ids))
        (fail ()) tin.wildcard_imports tin

and m_name_info a b =
  match (a, b) with
  | ( { G.name_last = a0; name_middle = a1; name_top = a2; name_info = a3 },
      { B.name_last = b0; name_middle = b1; name_top = b2; name_info = b3 } ) ->
      let* () = m_ident_and_type_arguments a0 b0 in
      let* () = (m_option m_qualifier) a1 b1 in
      let* () = (m_option m_tok) a2 b2 in
      let* () = m_id_info a3 b3 in
      return ()

and m_ident_and_type_arguments (a1, a2) (b1, b2) =
  let* () = m_ident a1 b1 in
  let* () = m_option m_type_arguments a2 b2 in
  return ()

and m_qualifier a b =
  match (a, b) with
  (* Like for m_dotted_name, [$X] should match anything *)
  | G.QDots [ ((str, t), _) ], B.QDots b when Mvar.is_metavar_name str ->
      envf (str, t) (MV.E (make_dotted (List_.map fst b)))
  | G.QDots a, B.QDots b -> m_list m_ident_and_type_arguments a b
  | G.QExpr (a1, a2), B.QExpr (b1, b2) -> m_expr a1 b1 >>= fun () -> m_tok a2 b2
  | G.QDots _, _
  | G.QExpr _, _ ->
      fail ()

(* semantic! try to handle typed metavariables by querying LSP
 * to get inferred type info (only for OCaml for now) *)
and m_type_option_with_hook idb taopt tbopt =
  match (taopt, tbopt) with
  | Some ta, Some tb -> m_type_ ta tb
  | Some ta, None -> (
      match !Hooks.get_type idb with
      | Some tb -> m_type_ ta tb
      | None -> fail ())
  (* less-is-ok:, like m_option_none_can_match_some *)
  | None, _ -> return ()

(* This is similar to m_ident, but it will also add the id_info in
 * the environment (via 'MV.Id (_, Some id_info)') when the pattern is
 * a metavariable. This id_info is useful to make sure multiple
 * occurences of the same metavariable binds to the same entity thanks
 * to the sid stored in the id_info.
 *)
and m_ident_and_id_info (a1, a2) (b1, b2) =
  (* metavar: *)
  match (a1, b1) with
  | (str, tok), b when Mvar.is_metavar_name str ->
      (* a bit OCaml specific, cos only ml_to_generic tags id_type in pattern *)
      m_type_option_with_hook b1 !(a2.G.id_type) !(b2.B.id_type) >>= fun () ->
      m_id_info a2 b2 >>= fun () -> envf (str, tok) (MV.Id (b, Some b2))
  (* same code than for m_ident *)
  (* in some languages such as Javascript certain entities like
   * fields can use strings for identifiers (e.g., {"myfield": 1}),
   * which gives the opportunity to use regexp string for fields
   * (e.g., {"=~/.*field/": $X}).
   *)
  | (stra, _), (strb, _) when Pattern.is_regexp_string stra ->
      let re_match = Matching_generic.regexp_matcher_of_regexp_string stra in
      if re_match strb then return () else fail ()
  (* general case *)
  | _, _ ->
      let case_insensitive =
        G.is_case_insensitive a2 && B.is_case_insensitive b2
      in
      let* () = m_wrap (m_id_string case_insensitive) a1 b1 in
      m_id_info a2 b2

and m_ident_and_empty_id_info a1 b1 =
  let empty = G.empty_id_info () in
  m_ident_and_id_info (a1, empty) (b1, empty)

(* Currently m_id_info is a Nop because the Semgrep pattern
 * does not have correct name resolution (see the comment below).
 * However, we do use id_info in equal_ast() to check
 * whether two $X refers to the same code. In that case we are using
 * the id_resolved tag and sid!
 *)
and m_id_info a b =
  match (a, b) with
  | ( {
        G.id_resolved = _a1;
        id_resolved_alternatives = _a2;
        id_type = _a3;
        id_svalue = _a4;
        id_flags = _a5;
        id_info_id = _a6;
      },
      {
        B.id_resolved = _b1;
        id_resolved_alternatives = _b2;
        id_type = _b3;
        id_svalue = _b4;
        id_flags = _b5;
        id_info_id = _b6;
      } ) ->
      (* old: (m_ref m_resolved_name) a3 b3  >>= (fun () ->
       * but doing import flask in a source file means every reference
       * to flask.xxx will be tagged with a ImportedEntity, but
       * semgrep pattern will use flask.xxx directly, without the preceding
       * import, without this tag, which would prevent
       * matching. We need to correctly resolve names and always compare with
       * the resolved_name instead of the name used in the code
       * (which can be an alias)
       *
       * old: (m_ref (m_option m_type_)) a2 b2
       * the same is true for types! Now we sometimes propagate type annotations
       * in Naming_AST.ml, but we do that in the source file, not the pattern,
       * which would prevent a match.
       * More generally, id_info is something populated and used on the
       * generic AST of the source, not on the pattern, hence we should
       * not use it as a condition for matching here. Instead use
       * the information in the caller.
       *)
      return ()

(*****************************************************************************)
(* Expression *)
(*****************************************************************************)

and m_expr_deep a b tin =
  let symbolic_propagation = tin.config.Options.symbolic_propagation in
  let subexprs_of_expr =
    SubAST_generic.subexprs_of_expr ~symbolic_propagation
  in
  (* Deep expression matching extracts sub-expressions without decomposing on the pattern,
     meaning that matching those sub-expressions should be considered as the root.
  *)
  m_deep m_expr_deep m_expr_root subexprs_of_expr a b tin

(* possibly go deeper. When someone writes a pattern like
 *   'bar();'
 * he may also want to match an expression statement like
 *   'x = bar();'.
 *
 * This is very hacky.
 *
 * alternatives:
 *  - force the user to use 'if(... <expr> ...)' (isaac, jmelton)
 *  - do as in coccinelle and use 'if(<... <expr> ...>)'
 *  - CURRENT: impicitely go deep without requiring an extra syntax
 *
 * todo? we could restrict ourselves to only a few forms?
 *   - x = <expr>,
 *   - <call>(<exprs).
 * see SubAST_generic.subexprs_of_expr_implicit
 *
 *)
and m_expr_deep_implict a b tin =
  let symbolic_propagation = tin.config.Options.symbolic_propagation in
  let subexprs_of_expr =
    SubAST_generic.subexprs_of_expr_implicit ~symbolic_propagation
  in
  (* Deep expression matching extracts sub-expressions without decomposing on the pattern,
     meaning that matching those sub-expressions should be considered as the root.
  *)
  m_deep m_expr_deep_implict m_expr_root subexprs_of_expr a b tin

(* This just calls `m_expr_inner` as the root. This is exposed, so that exterior uses will
   properly register as the root, and should only be called at the start of matching.
*)
and m_expr_root a b = m_expr ~is_root:true a b

(* This allows the matching of expressions, where we are considered to not be
   at the "root" of the pattern.
   This is because, for most of the other mutually recursive uses of `m_expr`, we are
   usually having already decomposed on the pattern, meaning that it is safe to
   use `m_expr`.
*)
(* coupling: if you add special sgrep hooks here, you should probably
 * also add them in m_pattern
 *)
(* `arguments_have_changed` should be false if this is not the first time
   `m_expr` has recursively tried to match the SAME `a` and `b`.
   This allows some cases to be "try-once", and fall-through to the others in
   all the other cases.
*)
and m_expr ?(is_root = false) ?(arguments_have_changed = true) a b =
  Trace_matching.(if on then print_expr_pair a b);
  match (a.G.e, b.G.e) with
  (* the order of the matches matters! take care! *)
  (* alias: match on the expr inside *)
  | G.Alias (_alias, a1), _ -> m_expr a1 b
  | _, G.Alias (_alias, b1) -> m_expr a b1
  (* equivalence: user-defined equivalence! *)
  | G.DisjExpr (a1, a2), _b -> m_expr a1 b >||> m_expr a2 b
  | G.LocalImportAll (a0, a1, a2), B.LocalImportAll (b0, b1, b2) ->
      let* () = m_module_name a0 b0 in
      let* () = m_tok a1 b1 in
      m_expr a2 b2
  | _, G.LocalImportAll (b0, _b1, b2) -> (
      match b0 with
      | G.DottedName bn -> with_additional_wildcard_import bn (m_expr a b2)
      | G.FileName _ -> fail ())
  (* This case should only run exactly once.
     This is so we do not endlessly loop trying to match to the same two things.
     By setting `arguments_have_changed` to false, we ensure that we
     fall-through to the cases that do decompose on `a` or `b`.
  *)
  | _, G.Cast (_, _, b1) when arguments_have_changed ->
      (* We apply this equivalence only if not at the root, meaning we've done
         work to get here, and should consider all possibilities.
         This is similar to symbolic propagation.
      *)
      (if not is_root then m_expr a b1 else fail ())
      >||> m_expr ~arguments_have_changed:false a b
  (* equivalence: name resolving! *)
  (* todo: it would be nice to factorize the aliasing code by just calling
   * m_name, but below we use make_dotted, which is different from what
   * we do in m_name.
   *)
  | ( _a,
      B.N
        (B.Id
          ( idb,
            {
              B.id_resolved =
                {
                  contents =
                    Some
                      ( ( B.ImportedEntity canonical
                        | B.ImportedModule canonical
                        | B.GlobalName (canonical, _) ),
                        _sid );
                };
              _;
            } )) )
    when arguments_have_changed ->
      let dotted = G.canonical_to_dotted (snd idb) canonical in
      (* We used to force to fully qualify entities in the pattern
       * (e.g., with org.foo(...)) but this is confusing for users.
       * We now allow an unqualified pattern like 'foo' to match resolved
       * entities like import org.foo; foo(), just like for attributes.
       *)
      (* coupling: resolved names with wildcards *)
      wipe_wildcard_imports
        ((* try matching the expression a and the identifier b *)
         m_expr ~arguments_have_changed:false a b
        >||> (* try again without symbolic propagated information in id_info
                *
                * TODO(yosef): this case could probably be refactored; this
                * handles an edge case that involves resolving imported names in
                * javascript such that import { Foo } = require('a'); var x = new
                * Foo({ y : 1}) matches the rule `new a.Foo({ y : 1})`
             *)
        m_expr ~arguments_have_changed:false a
          (B.N (B.Id (idb, static_empty_id_info)) |> G.e)
        >||> (* try this time a match with the resolved entity *)
        m_expr a (make_dotted dotted))
  (* equivalence: name resolving on qualified ids (for OCaml) *)
  (* Put this before the next case to prevent overly eager dealiasing *)
  | G.N (G.IdQualified _ as na), B.N ((B.IdQualified _ | B.Id _) as nb) ->
      m_name na nb
  (* Matches pattern
   *   a.b.C.x
   * to code
   *   import a.b.C
   *   C.x
   *)
  | ( G.N
        (G.IdQualified
          {
            G.name_last = alabel, None;
            name_middle = Some (G.QDots names);
            name_top = None;
            _;
          }),
      _b ) ->
      (* TODO: double check names does not have any type_args *)
      let full = (names |> List_.map fst) @ [ alabel ] in
      m_expr (make_dotted full) b
  | G.DotAccess (_, _, _), B.N b1 ->
      (* Reinterprets a DotAccess expression such as a.b.c as a name, when
       * a,b,c are all identifiers. Note that something like a.b.c could get
       * parsed as either DotAccess or IdQualified depending on the context
       * (e.g., in Python it is always a DotAccess *except* when it occurs
       * in an attribute). *)
      (match H.name_of_dot_access a with
      | None -> fail ()
      | Some a1 -> m_name a1 b1)
      >||> m_with_symbolic_propagation ~is_root (fun b1 -> m_expr a b1) b
  (* $X should not match an IdSpecial in a call context,
   * otherwise $X(...) would match a+b because this is transformed in a
   * Call(IdSpecial Plus, ...).
   * bugfix: note that we must forbid that only in a Call context; we want
   * $THIS to match IdSpecial (This) for example.
   *)
  | ( G.Call ({ e = G.N (G.Id ((str, _tok), _id_info)); _ }, _argsa),
      B.Call ({ e = B.IdSpecial (idspec, _); _ }, _argsb) )
    when Mvar.is_metavar_name str && not (should_match_call idspec) ->
      fail ()
  (* metavar: *)
  (* Matching a generic Id metavariable to an IdSpecial will fail as it is
   * missing the token info; instead the Id should match Call(IdSpecial _, _)
   *)
  | G.N (G.Id ((str, _), _)), B.IdSpecial (B.ConcatString _, _)
  | G.N (G.Id ((str, _), _)), B.IdSpecial (B.Instanceof, _)
    when Mvar.is_metavar_name str ->
      fail ()
  (* Important to bind to MV.Id when we can, so this must be before
   * the next case where we bind to the more general MV.E.
   * TODO: should be B.N (B.Id _ | B.IdQualified _)?
   *)
  | G.N (G.Id _ as na), B.N (B.Id _ as nb) ->
      m_name na nb
      >||> m_with_symbolic_propagation ~is_root (fun b1 -> m_expr a b1) b
  | G.N (G.Id ((str, tok), _id_info)), _b when Mvar.is_metavar_name str ->
      envf (str, tok) (MV.E b)
  (* metavar: typed! *)
  | G.TypedMetavar ((str, tok), _, t), _b when Mvar.is_metavar_name str ->
      with_lang (fun lang -> m_compatible_type lang (str, tok) t b)
  (* dots: should be patterned-match before in arguments, or statements,
   * but this is useful for keyword parameters, as in f(..., foo=..., ...)
   *)
  | G.Ellipsis _a1, _ -> return ()
  | G.DeepEllipsis (_, a1, _), _b -> m_expr_deep a1 b
  (* equivalence: (-) E vs -n ==> E vs n *)
  | ( G.Call ({ e = G.IdSpecial (G.Op G.Minus, _); _ }, (_, [ G.Arg arga ], _)),
      B.L (B.Int int_lit) ) ->
      m_expr arga (B.L (B.Int (Parsed_int.neg int_lit)) |> B.e)
  (* equivalence: -n vs (-) E ==> n vs E *)
  | ( G.L (G.Int int_lit),
      B.Call ({ e = B.IdSpecial (B.Op B.Minus, _); _ }, (_, [ B.Arg argb ], _))
    ) ->
      m_expr (G.L (G.Int (Parsed_int.neg int_lit)) |> G.e) argb
  (* must be before constant propagation case below *)
  | G.L a1, B.L b1 -> m_literal a1 b1
  (* equivalence: constant propagation and evaluation!
   * TODO: too late, must do that before 'metavar:' so that
   * const a = "foo"; ... a == "foo" would be caught by $X == $X.
   *)
  | G.L a1, _b ->
      if_config
        (fun x -> x.Options.constant_propagation)
        ~then_:
          (with_lang (fun lang ->
               match
                 Constant_propagation.constant_propagation_and_evaluate_literal
                   ~lang b
               with
               | Some b1 -> m_literal_svalue a1 b1
               | None -> fail ()))
        ~else_:(fail ())
  | G.Container (G.Array, a2), B.Container (B.Array, b2) ->
      (m_bracket m_container_ordered_elements) a2 b2
  | G.Container (G.List, a2), B.Container (B.List, b2) ->
      (m_bracket m_container_ordered_elements) a2 b2
  | G.Container (G.Tuple, a1), B.Container (B.Tuple, b1) ->
      (m_container_ordered_elements |> m_bracket) a1 b1
  | ( G.Container (((G.Set | G.Dict) as a1), (_, a2, _)),
      B.Container (((B.Set | B.Dict) as b1), (_, b2, _)) ) ->
      m_container_set_or_dict_unordered_elements (a1, a2) (b1, b2)
  (* dots: equivalence: Container and Comprehension *)
  | ( G.Container (akind, (_, [ { e = G.Ellipsis _; _ } ], _)),
      B.Comprehension (bkind, _) ) ->
      m_container_operator akind bkind
  (* dots '...' for string literal:
   * Interpolated strings are transformed into Call(Special(Concat, ...),
   * hence we want Python patterns like f"...{$X}...", which are expanded to
   * Call(Special(Concat, [L"..."; Id "$X"; L"..."])) to
   * match concrete code like f"foo{a}" such that "..." is seemingly
   * matching 0 or more literal expressions.
   * bugfix: note that we want to do that only when inside
   * Call(Special(Concat(...))), hence the special m_arguments_concat below,
   * otherwise regular call patterns like foo("...") would match code like
   * foo().
   *)
  | ( G.Call ({ e = G.IdSpecial (G.ConcatString akind, _a1); _ }, a2),
      B.Call ({ e = B.IdSpecial (B.ConcatString bkind, _b1); _ }, b2) ) ->
      m_concat_string_kind akind bkind >>= fun () ->
      m_bracket m_arguments_concat a2 b2
  (* The pattern '$X = 1 + 2 + ...' is parsed as '$X = (1 + 2) + ...', but
   * if the concrete code is 'foo = 1 + 2 + 3 + 4', this will naively not
   * match because (1+2)+... will be matched against ((1+2)+3)+4 and fails.
   * The ellipsis operator with binary operators should be more flexible
   * and allows any number of additional arguments, which when translated
   * in Call() means we need to go deeper.
   *)
  | ( G.Call
        ( { e = G.IdSpecial (G.Op aop, _toka); _ },
          (_, [ G.Arg a1; G.Arg { e = G.Ellipsis _tdots; _ } ], _) ),
      B.Call
        ( { e = B.IdSpecial (B.Op bop, _tokb); _ },
          (_, [ B.Arg b1; B.Arg _b2 ], _) ) )
  (* This applies to any binary operation! Associative operators (declared
   * in AST_generic_helpers.is_associative_operator) are better handled by
   * m_call_op below. *)
    when (not (H.is_associative_operator aop)) || aop <> bop ->
      m_arithmetic_operator aop bop >>= fun () ->
      m_expr a1 b1 >!> fun () ->
      (* try again deeper on b1 *)
      m_expr a b1
  | ( G.Call ({ e = G.IdSpecial (G.Op aop, toka); _ }, aargs),
      B.Call ({ e = B.IdSpecial (B.Op bop, tokb); _ }, bargs) ) ->
      m_call_op aop toka aargs bop tokb bargs
  (* boilerplate *)
  | G.Call (a1, a2), B.Call (b1, b2) ->
      m_expr a1 b1 >>= fun () -> m_arguments a2 b2
  | G.New (_a0, a1, _a2, a3), B.New (_b0, b1, _b2, b3) ->
      m_type_ a1 b1 >>= fun () -> m_arguments a3 b3
  | G.Assign (a1, at, a2), B.Assign (b1, bt, b2) -> (
      m_expr a1 b1
      >>= (fun () -> m_tok at bt >>= fun () -> m_expr a2 b2)
      (* If the code has tuples as b1 and b2 and the lengths of
       * the tuples are equal, create a tuple of (variable, value)
       * pairs and try to match the pattern with each entry in the tuple.
       * This should enable multiple assignments if the number of
       * variables and values are equal. *)
      >||>
      match (b1.e, b2.e) with
      | B.Container (B.Tuple, (_, vars, _)), B.Container (B.Tuple, (_, vals, _))
        when List.length vars =|= List.length vals ->
          let create_assigns expr1 expr2 = B.Assign (expr1, bt, expr2) |> G.e in
          let mult_assigns = List_.map2 create_assigns vars vals in
          let rec aux xs =
            match xs with
            | [] -> fail ()
            | x :: xs -> m_expr a x >||> aux xs
          in
          aux mult_assigns
      | _, _ -> fail ())
  (* bugfix: we also want o. ... .foo() to match o.foo(), but
   * o. ... would be matched against just 'o', so we need this
   * extra case.
   *)
  | ( G.DotAccess (({ e = G.DotAccessEllipsis (a1_1, _a1_2); _ } as a1), at, a2),
      B.DotAccess (b1, bt, b2) ) ->
      (* opti: Match field name first so we can bail quickly if it doesn't
       * match. This can allow us to avoid a relatively expensive match between
       * `a1` and `b1`, particularly when the target is a long chain of
       * `a.b.c.d.e` etc. and the pattern is of the form `$X. ... .foo`. *)
      let* () = m_field_name a2 b2 in
      let* () = m_expr a1 b1 >||> m_expr a1_1 b1 in
      m_tok at bt
  | G.DotAccess (a1, at, a2), B.DotAccess (b1, bt, b2) ->
      m_expr a1 b1 >>= fun () ->
      m_tok at bt >>= fun () -> m_field_name a2 b2
  (* <a1> ... vs o.m1().m2().m3().
   * Remember than o.m1().m2().m3() is parsed as (((o.m1()).m2()).m3())
   *)
  | ( G.DotAccessEllipsis (a1, _a2),
      (B.DotAccess _ | B.Call ({ e = B.DotAccess _; _ }, _)) ) ->
      (* => o, [m3();m2();m1() *)
      let obj, ys = obj_and_dot_accesses_of_expr b in
      (* the method chain ellipsis can match 0 or more of those method calls *)
      let candidates = all_suffix_of_list ys in
      let rec aux xxs =
        match xxs with
        | [] -> fail ()
        | xs :: xxs ->
            let b = expr_of_obj_and_dot_accesses (obj, xs) in
            m_expr a1 b >||> aux xxs
      in
      aux candidates
  | G.ArrayAccess (a1, a2), B.ArrayAccess (b1, b2) ->
      m_expr a1 b1 >>= fun () -> m_bracket m_expr a2 b2
  | G.Record a1, B.Record b1 -> (m_bracket m_fields) a1 b1
  | G.Constructor (a1, a2), B.Constructor (b1, b2) ->
      m_name a1 b1 >>= fun () -> m_bracket (m_list m_expr) a2 b2
  (* Pattern /.../ matches both regexp templates and regexp literals,
     whereas /$X/ matches only literals. *)
  | ( G.RegexpTemplate ((_l, { e = G.Ellipsis _; _ }, _r), a_opt),
      (B.RegexpTemplate (_, b_opt) | B.L (B.Regexp (_, b_opt))) ) ->
      m_regexp_options a_opt b_opt
  | G.RegexpTemplate (a, a_opt), B.RegexpTemplate (b, b_opt) ->
      let* () = m_bracket m_expr a b in
      m_regexp_options a_opt b_opt
  | G.Comprehension (a1, a2), B.Comprehension (b1, b2) ->
      let* () = m_container_operator a1 b1 in
      m_bracket m_comprehension a2 b2
  | G.Lambda a1, B.Lambda b1 ->
      m_function_definition a1 b1 >>= fun () -> return ()
  | G.AnonClass a1, B.AnonClass b1 -> m_class_definition a1 b1
  | G.IdSpecial a1, B.IdSpecial b1 -> m_wrap m_special a1 b1
  (* This is mainly for Go which generates an AssignOp (Eq)
   * for the x := a short variable declaration.
   * TODO: this should be a configurable equivalence: $X = $Y ==> $X := $Y.
   * Some people want it, some people may not want it.
   * At least we dont do the opposite (AssignOp matching Assign) so
   * using := in a pattern will not match code using just =
   * (but pattern using = will match both code using = or :=).
   *)
  | G.Assign (a1, a2, a3), B.AssignOp (b1, (B.Eq, b2), b3) ->
      m_expr (G.Assign (a1, a2, a3) |> G.e) (B.Assign (b1, b2, b3) |> G.e)
  | G.AssignOp (a1, a2, a3), B.AssignOp (b1, b2, b3) ->
      m_expr a1 b1 >>= fun () ->
      m_wrap m_arithmetic_operator a2 b2 >>= fun () -> m_expr a3 b3
  | G.Xml a1, B.Xml b1 -> m_xml a1 b1
  | G.LetPattern (a1, a2), B.LetPattern (b1, b2) ->
      m_pattern a1 b1 >>= fun () -> m_expr a2 b2
  | G.SliceAccess (a1, a2), B.SliceAccess (b1, b2) ->
      let f = m_option m_expr in
      m_expr a1 b1 >>= fun () -> m_bracket (m_tuple3 f f f) a2 b2
  | G.Conditional (a1, a2, a3), B.Conditional (b1, b2, b3) ->
      m_expr a1 b1 >>= fun () ->
      m_expr a2 b2 >>= fun () -> m_expr a3 b3
  | G.Yield (a0, a1, a2), B.Yield (b0, b1, b2) ->
      m_tok a0 b0 >>= fun () ->
      m_option m_expr a1 b1 >>= fun () -> m_bool a2 b2
  | G.Await (a0, a1), B.Await (b0, b1) -> m_tok a0 b0 >>= fun () -> m_expr a1 b1
  | G.Cast (a1, at, a2), B.Cast (b1, bt, b2) ->
      m_type_ a1 b1 >>= fun () ->
      m_tok at bt >>= fun () -> m_expr a2 b2
  | G.Seq a1, B.Seq b1 -> (m_list m_expr) a1 b1
  | G.Ref (a0, a1), B.Ref (b0, b1) -> m_tok a0 b0 >>= fun () -> m_expr a1 b1
  | G.DeRef (a0, a1), B.DeRef (b0, b1) -> m_tok a0 b0 >>= fun () -> m_expr a1 b1
  | G.StmtExpr a1, B.StmtExpr b1 -> m_stmt a1 b1
  (* implicit return *)
  | G.StmtExpr { s = G.Return (_, Some a, _); _ }, _ -> m_implicit_return a b
  | G.OtherExpr (a1, a2), B.OtherExpr (b1, b2) ->
      m_todo_kind a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.RawExpr a, B.RawExpr b -> m_raw_tree a b
  | G.N (G.Id _ as a), B.N (B.IdQualified _ as b) -> m_name a b
  | _, G.N (G.Id _) ->
      m_with_symbolic_propagation ~is_root (fun b1 -> m_expr a b1) b
  | G.ArrayAccess _, _
  | G.Call _, _
  | G.Container _, _
  | G.Comprehension _, _
  | G.Record _, _
  | G.Constructor _, _
  | G.RegexpTemplate _, _
  | G.Lambda _, _
  | G.AnonClass _, _
  | G.N _, _
  | G.New _, _
  | G.IdSpecial _, _
  | G.Xml _, _
  | G.Assign _, _
  | G.AssignOp _, _
  | G.LetPattern _, _
  | G.DotAccess _, _
  | G.SliceAccess _, _
  | G.Conditional _, _
  | G.Yield _, _
  | G.Await _, _
  | G.Cast _, _
  | G.Seq _, _
  | G.Ref _, _
  | G.DeRef _, _
  | G.LocalImportAll _, _
  | G.StmtExpr _, _
  | G.OtherExpr _, _
  | G.RawExpr _, _
  | G.TypedMetavar _, _
  | G.DotAccessEllipsis _, _ ->
      fail ()

(* Require an exact match between raw trees except for Any nodes which
   are matched normally. *)
and m_raw_tree (a : G.raw_tree) (b : G.raw_tree) =
  Trace_matching.(if on then print_raw_pair a b);
  match (a, b) with
  (* metavar:
   * We add those extra (Case (_)) or-pattern below because the metavar
   * could be nested but we want to match at the toplevel.
   * For instance, Case("Sym_lit", Token("$X")) should also match
   * Case("Num_lit", Token(("2"))).
   * TODO? When should we stop? use >||> and try at each level?
   *)
  | ( ( Token (str, tok)
      | Case (_, Token (str, tok))
      | Case (_, Case (_, Token (str, tok))) ),
      b )
    when Mvar.is_metavar_name str ->
      envf (str, tok) (MV.Raw b)
  (* dots: on string.
   * TODO: we should use m_string_ellipsis_or_metavar_or_default,
   * but this would require to remove the enclosing quotes first
   *)
  | Token ("\"...\"", _), Token (sb, _) when sb =~ "^\".*\"$" -> return ()
  | Token a, Token b -> m_wrap m_string a b
  (* dots:
   * TODO? restrict it to just List?
   * TODO? we should also accept Any (Expr (Ellipsis)) below. Indeed,
   * once you start to migrate out of the raw_tree to the real generic AST,
   * you could get a mix of Raw_tree and generic AST that we need to match
   * together.
   *)
  | List a, List b
  | Tuple a, Tuple b ->
      m_list_with_dots m_raw_tree
        (function
          | Token ("...", _) -> true
          | Case (_, Token ("...", _)) -> true
          | Case (_, Case (_, Token ("...", _))) -> true
          | _ -> false)
        ~less_is_ok:false (* empty list can not match non-empty list *) a b
  | Case (a_cons, a), Case (b_cons, b) ->
      m_string a_cons b_cons >>= fun () -> m_raw_tree a b
  | Option a, Option b -> m_option m_raw_tree a b
  | Any a, Any b -> m_any a b
  | Token _, _
  | List _, _
  | Tuple _, _
  | Case _, _
  | Option _, _
  | Any _, _ ->
      fail ()

and m_entity_name a b =
  match (a, b) with
  | G.EN a1, B.EN b1 -> m_name a1 b1
  | G.EN (G.Id ((str, tok), _idinfoa)), B.EDynamic b1
    when Mvar.is_metavar_name str ->
      envf (str, tok) (MV.E b1)
  (* boilerplate *)
  | G.EDynamic a, B.EDynamic b -> m_expr a b
  | G.EPattern a, B.EPattern b -> m_pattern a b
  | G.OtherEntity (a1, a2), B.OtherEntity (b1, b2) ->
      m_todo_kind a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.EN _, _
  | G.EPattern _, _
  | G.OtherEntity _, _
  | G.EDynamic _, _ ->
      fail ()

and m_field_name a b =
  match (a, b) with
  | G.FN a1, B.FN b1 -> m_name a1 b1
  | G.FN (G.Id ((str, tok), _idinfoa)), B.FDynamic b1
    when Mvar.is_metavar_name str ->
      envf (str, tok) (MV.E b1)
  (* boilerplate *)
  | G.FDynamic a, B.FDynamic b -> m_expr a b
  | G.FN _, _
  | G.FDynamic _, _ ->
      fail ()

and m_label_ident a b =
  match (a, b) with
  | G.LNone, B.LNone -> return ()
  | G.LId a, B.LId b -> m_label a b
  | G.LInt a, B.LInt b -> m_wrap m_int a b
  | G.LDynamic a, B.LDynamic b -> m_expr a b
  | G.LNone, _
  | G.LId _, _
  | G.LInt _, _
  | G.LDynamic _, _ ->
      fail ()

and m_comprehension (a1, a2) (b1, b2) =
  let* () = m_expr a1 b1 in
  m_list m_for_or_if_comp a2 b2

and m_for_or_if_comp a b =
  match (a, b) with
  | G.CompFor (a1, a2, a3, a4), B.CompFor (b1, b2, b3, b4) ->
      let* () = m_tok a1 b1 in
      let* () = m_pattern a2 b2 in
      let* () = m_tok a3 b3 in
      let* () = m_expr a4 b4 in
      return ()
  | G.CompIf (a1, a2), B.CompIf (b1, b2) ->
      let* () = m_tok a1 b1 in
      let* () = m_expr a2 b2 in
      return ()
  | G.CompFor _, _
  | G.CompIf _, _ ->
      fail ()

(* This just does some special coercions for Terraform.
   If not a Terraform language, skip straight to `m_literal_inner`.
   https://developer.hashicorp.com/terraform/language/expressions/type-constraints
*)
and m_literal a b =
  Trace_matching.(if on then print_literal_pair a b);
  with_lang (fun lang ->
      if Lang.equal lang Lang.Terraform then
        (* We choose not to use an or-pattern to maintain the
           sides of the trees.
        *)
        match (a, b) with
        | G.Int (opt, t), B.String (_, (b1, b2), _) ->
            let i = Option.map Int64.to_string opt in
            m_wrap_m_string_opt (i, t) (Some b1, b2)
        | G.String (_, (a1, a2), _), G.Int (opt, t) ->
            let i = Option.map Int64.to_string opt in
            m_wrap_m_string_opt (Some a1, a2) (i, t)
        | G.Bool (a1, a2), B.String (_, (b1, b2), _) ->
            let b = Bool.to_string a1 in
            m_wrap m_string (b, a2) (b1, b2)
        | G.String (_, (a1, a2), _), B.Bool (b1, b2) ->
            let b = Bool.to_string b1 in
            m_wrap m_string (a1, a2) (b, b2)
        (* For the float case, we coerce from string to float, rather
           than float to string.
           While this is not strictly what Hcl does, this is because we
           may have inconsistency in how floats are represented, as strings.
        *)
        | G.Float (a1, a2), B.String (_, (b1, b2), _) ->
            let f = Float.of_string_opt b1 in
            m_wrap_m_float_opt (a1, a2) (f, b2)
        | G.String (_, (a1, a2), _), B.Float (b1, b2) ->
            let f = Float.of_string_opt a1 in
            m_wrap_m_float_opt (f, a2) (b1, b2)
        | __else__ -> m_literal_inner a b
      else m_literal_inner a b)

and m_literal_inner a b =
  Trace_matching.(if on then print_literal_pair a b);
  match (a, b) with
  (* dots: metavar: '...' and metavars on string/regexps/atoms *)
  | G.String (_, a, _), B.String (_, b, _) ->
      (* iso? don't care about the kind of quotes used? *)
      m_string_ellipsis_or_metavar_or_default a b
  | G.Atom (_, a), B.Atom (_, b) -> m_ellipsis_or_metavar_or_string a b
  | G.Regexp (a1, a2), B.Regexp (b1, b2) -> (
      let* () = m_bracket m_ellipsis_or_metavar_or_string a1 b1 in
      match (a2, b2) with
      (* less_is_ok: *)
      | None, _ -> return ()
      | Some a, Some b -> m_ellipsis_or_metavar_or_string a b
      | Some _, None -> fail ())
  (* boilerplate *)
  | G.Unit a1, B.Unit b1 -> m_tok a1 b1
  | G.Bool a1, B.Bool b1 -> (m_wrap m_bool) a1 b1
  | G.Int a1, B.Int b1 -> m_parsed_int a1 b1
  | G.Float a1, B.Float b1 -> m_wrap_m_float_opt a1 b1
  | G.Imag a1, B.Imag b1 -> (m_wrap m_string) a1 b1
  | G.Ratio a1, B.Ratio b1 -> (m_wrap m_string) a1 b1
  | G.Char a1, B.Char b1 -> (m_wrap m_string) a1 b1
  | G.Null a1, B.Null b1 -> m_tok a1 b1
  | G.Undefined a1, B.Undefined b1 -> m_tok a1 b1
  | G.Unit _, _
  | G.Bool _, _
  | G.Int _, _
  | G.Float _, _
  | G.Char _, _
  | G.String _, _
  | G.Regexp _, _
  | G.Null _, _
  | G.Undefined _, _
  | G.Imag _, _
  | G.Ratio _, _
  | G.Atom _, _ ->
      fail ()

and m_parsed_int (a1, a2) (b1, b2) =
  match (a1, b1) with
  (* iso: semantic equivalence of value! 0x8 can match 8 *)
  | Some i1, Some i2 -> if Int64.equal i1 i2 then return () else fail ()
  (* if the integers (or floats) were too large or were using
   * a syntax OCaml int_of_string could not parse,
   * we default to a string comparison *)
  | _ ->
      let a1 = Tok.content_of_tok a2 in
      (* bugfix: not that with constant propagation, some integers don't have
       * a real token associated with them, so b2 may be a FakeTok, but
       * Parse_info.str_of_info does not raise an exn anymore on a FakeTok
       *)
      let b1 = Tok.content_of_tok b2 in
      m_wrap m_string (a1, a2) (b1, b2)

and m_wrap_m_string_opt (a1, a2) (b1, b2) =
  match (a1, b1) with
  | Some s1, Some s2 when String.equal s1 s2 -> return ()
  | _ ->
      let a1 = Tok.content_of_tok a2 in
      let b1 = Tok.content_of_tok b2 in
      m_wrap m_string (a1, a2) (b1, b2)

and m_wrap_m_float_opt (a1, a2) (b1, b2) =
  match (a1, b1) with
  (* iso: semantic equivalence of value! 0x8 can match 8 *)
  | Some f1, Some f2 when f1 =*= f2 -> return ()
  | _ ->
      let a1 = Tok.content_of_tok a2 in
      let b1 = Tok.content_of_tok b2 in
      m_wrap m_string (a1, a2) (b1, b2)

and m_literal_svalue a b =
  match b with
  | B.Lit b1 -> m_literal a b1
  | B.Cst B.Cstr -> (
      match a with
      | G.String (_, ("...", _), _) -> return ()
      | ___else___ -> fail ())
  | B.Cst _
  | B.Sym _
  | B.NotCst ->
      fail ()

and m_arithmetic_operator a b =
  Trace_matching.(if on then print_arithmetic_operator_pair a b);
  match (a, b) with
  | _ when a =*= b -> return ()
  | _ -> fail ()

and m_special a b =
  match (a, b) with
  | G.This, B.This -> return ()
  | G.Super, B.Super -> return ()
  | G.Self, B.Self -> return ()
  | G.Parent, B.Parent -> return ()
  | G.Eval, B.Eval -> return ()
  | G.Typeof, B.Typeof -> return ()
  | G.Instanceof, B.Instanceof -> return ()
  | G.Sizeof, B.Sizeof -> return ()
  | G.Defined, B.Defined -> return ()
  | G.ConcatString a, B.ConcatString b -> m_concat_string_kind a b
  | G.InterpolatedElement, B.InterpolatedElement -> return ()
  | G.Spread, B.Spread -> return ()
  | G.HashSplat, B.HashSplat -> return ()
  | G.ForOf, B.ForOf -> return ()
  | G.Op a1, B.Op b1 -> m_arithmetic_operator a1 b1
  | G.EncodedString a1, B.EncodedString b1 -> m_string a1 b1
  | G.IncrDecr (a1, a2), B.IncrDecr (b1, b2) ->
      m_eq a1 b1 >>= fun () -> m_eq a2 b2
  | G.NextArrayIndex, B.NextArrayIndex -> return ()
  | G.Require, B.Require -> return ()
  | G.This, _
  | G.Super, _
  | G.Self, _
  | G.Parent, _
  | G.Eval, _
  | G.Typeof, _
  | G.Instanceof, _
  | G.Sizeof, _
  | G.ConcatString _, _
  | G.Spread, _
  | G.Op _, _
  | G.IncrDecr _, _
  | G.EncodedString _, _
  | G.HashSplat, _
  | G.Defined, _
  | G.ForOf, _
  | G.NextArrayIndex, _
  | G.Require, _
  | InterpolatedElement, _ ->
      fail ()

and m_concat_string_kind a b =
  match (a, b) with
  (* fstring pattern should match only fstring *)
  | G.FString s1, B.FString s2 -> m_string s1 s2
  | G.FString _, _ -> fail ()
  (* same for tagged template literals *)
  | G.TaggedTemplateLiteral, B.TaggedTemplateLiteral -> return ()
  | G.TaggedTemplateLiteral, _
  | _, B.TaggedTemplateLiteral ->
      fail ()
  (* less-is-more: *)
  | _ -> return ()

and m_container_set_or_dict_unordered_elements (a1, a2) (b1, b2) =
  match ((a1, a2), (b1, b2)) with
  (* those rules should be applied only for python? *)
  | ((G.Dict | G.Set), []), ((G.Dict | G.Set), []) -> return ()
  | ((G.Dict | G.Set), [ { e = G.Ellipsis _; _ } ]), ((G.Dict | G.Set), _) ->
      return ()
  | (G.Set, a2), (B.Set, b2) ->
      let has_ellipsis, a2 = has_ellipsis_and_filter_ellipsis a2 in
      m_list_in_any_order ~less_is_ok:has_ellipsis m_expr a2 b2
  | (G.Dict, a2), (B.Dict, b2) ->
      let has_ellipsis, a2 = has_ellipsis_and_filter_ellipsis a2 in
      m_list_in_any_order ~less_is_ok:has_ellipsis m_expr a2 b2
  | _, _ ->
      (* less: could return fail () *)
      m_container_operator a1 b1 >>= fun () -> m_list m_expr a2 b2

(* coupling: if you add a constructor in AST_generic.container,
 * you probrably need to update m_container_set_or_dict_unordered_elements
 * and m_expr to handle this new kind of container.
 *)
and m_container_operator a b =
  match (a, b) with
  (* boilerplate *)
  | G.Array, B.Array -> return ()
  | G.List, B.List -> return ()
  | G.Set, B.Set -> return ()
  | G.Dict, B.Dict -> return ()
  | G.Tuple, B.Tuple -> return ()
  | G.Array, _
  | G.List, _
  | G.Set, _
  | G.Dict, _
  | G.Tuple, _ ->
      fail ()

and m_container_ordered_elements a b =
  m_list_with_dots m_expr
    (function
      | { e = G.Ellipsis _; _ } -> true
      | _ -> false)
    ~less_is_ok:false (* empty list can not match non-empty list *) a b

(* Poor's man typechecker. Note that some of the typing work is also
 * done in Naming_AST.get_resolved_type() (or in deepSemgrep in
 * Naming_SAST.map_expr()) and leveraged below via the id_type field.
 *
 * old: was partly in typing/Typechecking_generic.ml before.
 *
 * todo:
 *  - local type inference on AST generic? good coverage?
 *  - we could allow metavars on the type itself, as in
 *    foo($X: $T) ... $T x; ...
 *    which would require to transform the code in the generic_vs_generic
 *    style as typechecking could also bind metavariables in the process
 *)
and m_compatible_type lang typed_mvar t e =
  let t =
    match !Naming_AST.pro_hook_normalize_ast_generic_type with
    | Some f -> f lang t
    | None -> t
  in
  match (t.G.t, e.G.e) with
  (* for C specific literals *)
  | G.TyPointer (_, { t = TyN (G.Id (("char", _), _)); _ }), B.L (B.String _) ->
      envf typed_mvar (MV.E e)
  | G.TyPointer (_, _), B.L (B.Null _) -> envf typed_mvar (MV.E e)
  (* for C strings to match metavariable pointer types *)
  | ( G.TyPointer (t1, { t = G.TyN (G.Id ((_, tok), id_info)); _ }),
      B.L (B.String _) ) ->
      m_type_ t
        (G.TyPointer (t1, G.TyN (G.Id (("char", tok), id_info)) |> G.t) |> G.t)
      >>= fun () -> envf typed_mvar (MV.E e)
  | _ta, _eb -> (
      (match (t.G.t, e.G.e) with
      (* for matching ids *)
      (* this is covered by the basic type propagation done in Naming_AST.ml *)
      (* TODO Remove this case in favor of the newer type inference below. *)
      | _ta, B.N (B.Id (idb, ({ B.id_type = tb; _ } as id_infob))) ->
          (* NOTE: Name values must be represented with MV.Id! *)
          m_type_option_with_hook idb (Some t) !tb >>= fun () ->
          envf typed_mvar (MV.Id (idb, Some id_infob))
      | _else_ -> fail ())
      >||>
      let with_bound_metavar =
        match e.G.e with
        | B.N (B.Id (id, info)) ->
            (* NOTE: Name values must be represented with MV.Id! *)
            envf typed_mvar (MV.Id (id, Some info))
        | _else_ -> envf typed_mvar (MV.E e)
      in
      let tb, idopt = Typing.type_of_expr lang e in
      (* If we can infer the type, then match against it. Otherwise, fall back
       * on LSP type matching *)
      if Type.is_real_type tb then
        (* In case the pattern of the type itself contains a metavariable (e.g.
         * `(List<$T> $X)), take a token from the expression so that we have a
         * real location to associate with the metavariable. *)
        let tok =
          lazy
            (match H.ii_of_any (G.E e) |> List.filter Tok.is_origintok with
            | hd :: _ -> Some hd
            | [] -> None)
        in
        let* () = m_generic_type_vs_type_t lang tok t tb in
        with_bound_metavar
      else
        match idopt with
        | Some idb ->
            m_type_option_with_hook idb (Some t) None >>= fun () ->
            with_bound_metavar
        | None -> fail ())

(*---------------------------------------------------------------------------*)
(* XML *)
(*---------------------------------------------------------------------------*)
and m_xml a b =
  match (a, b) with
  | ( { G.xml_kind = a1; xml_attrs = a2; xml_body = a3 },
      { B.xml_kind = b1; xml_attrs = b2; xml_body = b3 } ) ->
      m_xml_kind a1 b1 >>= fun () ->
      m_attrs a2 b2 >>= fun () -> m_xml_bodies a3 b3

and m_xml_kind a b =
  match (a, b) with
  (* iso: allow a Classic to match a Singleton, and vice versa *)
  | G.XmlClassic (a0, a1, a2, _), B.XmlSingleton (b0, b1, b2)
  | G.XmlSingleton (a0, a1, a2), B.XmlClassic (b0, b1, b2, _) ->
      if_config
        (fun x -> x.Options.xml_singleton_loose_matching)
        ~then_:
          (let* () = m_tok a0 b0 in
           let* () = m_name a1 b1 in
           let* () = m_tok a2 b2 in
           return ())
        ~else_:(fail ())
  | G.XmlClassic (a0, a1, a2, a3), B.XmlClassic (b0, b1, b2, b3) ->
      let* () = m_tok a0 b0 in
      let* () = m_name a1 b1 in
      let* () = m_tok a2 b2 in
      let* () = m_tok a3 b3 in
      return ()
  | G.XmlSingleton (a0, a1, a2), B.XmlSingleton (b0, b1, b2) ->
      let* () = m_tok a0 b0 in
      let* () = m_name a1 b1 in
      let* () = m_tok a2 b2 in
      return ()
  | G.XmlFragment (a1, a2), B.XmlFragment (b1, b2) ->
      let* () = m_tok a1 b1 in
      let* () = m_tok a2 b2 in
      return ()
  | G.XmlClassic _, _
  | G.XmlSingleton _, _
  | G.XmlFragment _, _ ->
      fail ()

and m_attrs a b =
  let has_ellipsis, a =
    has_ellipsis_and_filter_ellipsis_gen
      (function
        | G.XmlEllipsis _ -> true
        | _ -> false)
      a
  in
  if_config
    (fun x -> x.xml_attrs_implicit_ellipsis)
    ~then_:(m_list_in_any_order ~less_is_ok:true m_xml_attr a b)
    ~else_:(m_list_in_any_order ~less_is_ok:has_ellipsis m_xml_attr a b)

and m_xml_bodies a b =
  match (a, b) with
  (* ugly: special case to avoid some regressions in
   * tests/rules/metavar_ellipsis_xmls.html which avoids
   * to bind $...JS to an empty list.
   * TODO: remove this special case
   *)
  | [ XmlText (s, tok) ], _ when Mvar.is_metavar_ellipsis s ->
      envf (s, tok) (MV.Xmls b)
  | _else_ ->
      (* alt: use with_lang and enabled it by default for Lang.Xml *)
      if_config
        (fun x -> x.xml_children_ordered)
        ~then_:
          (m_list_with_dots_and_metavar_ellipsis ~f:m_xml_body
             ~is_dots:(function
               | G.XmlText (s, _) -> String.trim s = "..."
               | _ -> false)
               (* less-is-ok: it's ok to have an empty body in the pattern *)
             ~less_is_ok:true
             ~is_metavar_ellipsis:(function
               | G.XmlText (s, tok) when Mvar.is_metavar_ellipsis s ->
                   Some ((s, tok), fun xs -> MV.Xmls xs)
               | _ -> None)
             a b)
        ~else_:
          (let has_ellipsis, a =
             has_ellipsis_and_filter_ellipsis_gen
               (function
                 | G.XmlText (s, _) -> String.trim s = "..."
                 | _ -> false)
               a
           in
           m_list_in_any_order ~less_is_ok:has_ellipsis m_xml_body a b)

and m_xml_attr a b =
  match (a, b) with
  | G.XmlAttr (a1, at, a2), B.XmlAttr (b1, bt, b2) ->
      let* () = m_ident a1 b1 in
      let* () = m_tok at bt in
      m_xml_attr_value a2 b2
  | G.XmlAttrExpr a1, B.XmlAttrExpr b1 -> m_bracket m_expr a1 b1
  | G.XmlEllipsis a1, B.XmlEllipsis b1 -> m_tok a1 b1
  | G.XmlAttr _, _
  | G.XmlAttrExpr _, _
  | G.XmlEllipsis _, _ ->
      fail ()

and m_xml_attr_value a b =
  (* less: deep? *)
  m_expr a b

and m_xml_body a b =
  match (a, b) with
  (* dots: the "..." is actually intercepted now in m_bodies *)
  | G.XmlText a1, B.XmlText b1 ->
      m_string_ellipsis_or_metavar_or_default
        ~m_string_for_default:m_string_xhp_text a1 b1
  (* boilerplate *)
  | G.XmlExpr a1, B.XmlExpr b1 ->
      (* less: could allow ... to match also a None *)
      m_bracket (m_option m_expr) a1 b1
  | G.XmlXml a1, B.XmlXml b1 -> m_xml a1 b1
  | G.XmlText _, _
  | G.XmlExpr _, _
  | G.XmlXml _, _ ->
      fail ()

(*---------------------------------------------------------------------------*)
(* Arguments list iso *)
(*---------------------------------------------------------------------------*)
and m_arguments a b =
  Trace_matching.(if on then print_arguments_pair a b);
  match (a, b) with
  | a, b -> m_bracket m_list__m_argument a b

(* less: factorize in m_list_with_dots? but also has unordered for kwd args *)
and m_list__m_argument (xsa : G.argument list) (xsb : G.argument list) =
  match (xsa, xsb) with
  | [], [] -> return ()
  (* dots: ..., can also match no argument *)
  | [ G.Arg { e = G.Ellipsis _i; _ } ], [] -> return ()
  (* dots: metavars: $...ARGS *)
  | G.Arg { e = G.N (G.Id ((s, tok), _idinfo)); _ } :: xsa, xsb
    when Mvar.is_metavar_ellipsis s ->
      (* can match 0 or more arguments (just like ...) *)
      let candidates = inits_and_rest_of_list_empty_ok xsb in
      let rec aux xs =
        match xs with
        | [] -> fail ()
        | (inits, rest) :: xs ->
            envf (s, tok) (MV.Args inits)
            >>= (fun () -> m_list__m_argument xsa rest)
            >||> aux xs
      in
      aux candidates
  | G.Arg { e = G.Ellipsis i; _ } :: xsa, xb :: xsb ->
      (* can match nothing *)
      m_list__m_argument xsa (xb :: xsb)
      >||> (* can match more *)
      m_list__m_argument (G.Arg (G.Ellipsis i |> G.e) :: xsa) xsb
  (* unordered kwd argument matching *)
  | (G.ArgKwd (((s, _tok) as ida), ea) as a) :: xsa, xsb
  | (G.ArgKwdOptional (((s, _tok) as ida), ea) as a) :: xsa, xsb -> (
      if Mvar.is_metavar_name s then
        let candidates = all_elem_and_rest_of_list xsb in
        (* less: could use a fold *)
        let rec aux xs =
          match xs with
          | [] -> fail ()
          | (b, xsb) :: xs ->
              m_argument a b
              >>= (fun () -> m_list__m_argument xsa (lazy_rest_of_list xsb))
              >||> aux xs
        in
        aux candidates
      else
        try
          let before, there, after =
            xsb
            |> Common2.split_when (function
                 | G.ArgKwd ((s2, _), _)
                 | G.ArgKwdOptional ((s2, _), _)
                   when s = s2 ->
                     true
                 | _ -> false)
          in
          match there with
          | G.ArgKwd (idb, eb)
          | G.ArgKwdOptional (idb, eb) ->
              m_ident ida idb >>= fun () ->
              m_expr ea eb >>= fun () -> m_list__m_argument xsa (before @ after)
          | _ -> raise Impossible
        with
        | Not_found -> fail ())
  (* the general case *)
  | xa :: aas, xb :: bbs ->
      m_argument xa xb >>= fun () -> m_list__m_argument aas bbs
  | [], xsb ->
      (* If the remaining arguments in the target code are all optional, it's
         a match. *)
      if
        List.for_all
          (function
            | G.ArgKwdOptional _ -> true
            | _ -> false)
          xsb
      then return ()
      else fail ()
  | _ :: _, _ -> fail ()

(* special case m_arguments when inside a Call(Special(Concat,_), ...)
 * less: factorize with m_list_with_dots? hard because of the special
 * call to Normalize_generic below.
 *)
and m_arguments_concat a b =
  let matcher xa xb =
    (* exception: for concat strings, don't have ellipsis/metavars match   *)
    (* string literals since string literals are implicitly not   *)
    (* interpolated, and ellipsis/metavars implicitly are                  *)
    match (xa, xb) with
    | G.Arg { e = G.Ellipsis _; _ }, G.Arg { e = G.L (G.String _); _ } ->
        fail ()
    | ( G.Arg { e = G.N (G.Id ((s, _tok), _idinfo)); _ },
        G.Arg { e = G.L (G.String _); _ } )
      when Mvar.is_metavar_name s ->
        fail ()
    | _ -> m_argument xa xb
  in
  let is_dots = function
    | G.Arg { e = G.L (G.String (_, ("...", _), _)); _ } -> true
    | _else_ -> false
  in
  let is_metavar_ellipsis = function
    | G.Arg { e = G.L (G.String (_, (s, tok), _)); _ }
      when Mvar.is_metavar_ellipsis s ->
        Some ((s, tok), fun xs -> MV.Args xs)
    | _else_ -> None
  in
  m_list_with_dots_and_metavar_ellipsis ~less_is_ok:false ~f:matcher ~is_dots
    ~is_metavar_ellipsis a b

and m_argument a b =
  Trace_matching.(if on then print_argument_pair a b);
  match (a, b) with
  (* TODO: iso on keyword argument, keyword is optional in pattern.
   * TODO: maybe Arg (N (Id "$S")) should be allowed to match
   * an ArgType or ArgOther (especially for C/C++ where typedef
   * inference is sometimes wrong when we get an ArgType instead of Arg.
   *)

  (* boilerplate *)
  | G.Arg a1, B.Arg b1 -> m_expr a1 b1
  | G.ArgType a1, B.ArgType b1 -> m_type_ a1 b1
  | G.ArgKwd (a1, a2), B.ArgKwd (b1, b2)
  | G.ArgKwdOptional (a1, a2), B.ArgKwdOptional (b1, b2) ->
      m_ident a1 b1 >>= fun () -> m_expr a2 b2
  | G.OtherArg (a1, a2), B.OtherArg (b1, b2) ->
      m_todo_kind a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.Arg _, _
  | G.ArgKwd _, _
  | G.ArgKwdOptional _, _
  | G.ArgType _, _
  | G.OtherArg _, _ ->
      fail ()

(*---------------------------------------------------------------------------*)
(* Associative-commutative iso *)
(*---------------------------------------------------------------------------*)
and m_call_op aop toka aargs bop tokb bargs tin =
  let is_commutative_operator = function
    | G.BitOr
    | G.BitAnd
    | G.BitXor ->
        true
    (* TODO: Plus, Mult, ... ? *)
    | G.And
    | G.Or ->
        tin.config.commutative_boolop
    | G.Eq
    | G.NotEq ->
        if tin.config.commutative_compop then
          (* nosemgrep: no-logs-in-library *)
          Logs.warn (fun m ->
              m
                "`commutative_compop` rule option has been deprecated. Please \
                 use `symmetric_eq` instead.");
        tin.config.commutative_compop || tin.config.symmetric_eq
    | __else__ -> false
  in
  let m_op_default aargs bargs =
    m_arithmetic_operator aop bop >>= fun () -> m_arguments aargs bargs
  in
  (* If this an AC operation we try to perform AC matching, otherwise we perform
   * regular non-AC matching. *)
  if tin.config.ac_matching && aop =*= bop then
    match (H.is_associative_operator aop, is_commutative_operator aop) with
    | true, is_commutative -> (
        match
          ( H.ac_matching_nf aop (Tok.unbracket aargs),
            H.ac_matching_nf bop (Tok.unbracket bargs) )
        with
        | Some aargs_ac, Some bargs_ac -> (
            match is_commutative with
            | true (* assoc and comm *) ->
                m_ac_op tokb aop aargs_ac bargs_ac tin
            | false (* assoc and not comm*) ->
                m_assoc_op tokb aop aargs_ac bargs_ac tin)
        | ___else___ ->
            Log.warn (fun m ->
                m
                  "Will not perform AC-matching, something went wrong when \
                   trying to convert operands to AC normal form: %s vs %s"
                  (G.show_expr
                     (G.Call (G.IdSpecial (G.Op aop, toka) |> G.e, aargs) |> G.e))
                  (B.show_expr
                     (B.Call (B.IdSpecial (B.Op bop, tokb) |> G.e, bargs) |> G.e)));
            m_op_default aargs bargs tin)
    | false, true (* not assoc and comm *) -> (
        match (aargs, bargs) with
        | (_, [ _; _ ], _), (tb1, [ b1; b2 ], tb2) ->
            tin
            |> (m_op_default aargs bargs
               >||> m_op_default aargs (tb1, [ b2; b1 ], tb2))
        | _ -> m_op_default aargs bargs tin)
    | false, false (* not assoc and not comm *) -> m_op_default aargs bargs tin
  else m_op_default aargs bargs tin

(* Associative-matching of operators.
 *
 * This is very similar to m_list__m_argument where $MVAR acts like $...$MVAR
 * (but cannot match an empty list of arguments).
 *
 * NOTE: There is not need for supporting $...MVAR here, and strictly speaking
 *   it doesn't apply either since we still see the operator as binary.
 *)
and m_assoc_op tok op aargs_ac bargs_ac =
  match (aargs_ac, bargs_ac) with
  | [], [] -> return ()
  (* dots: ..., can also match no argument *)
  | [ { e = G.Ellipsis _i; _ } ], [] -> return ()
  (* $MVAR, acting similar to $...MVAR *)
  | ({ e = G.N (G.Id ((s, _tok), _idinfo)); _ } as xa) :: xsa, xsb
    when Mvar.is_metavar_name s ->
      let candidates = inits_and_rest_of_list_empty_ok xsb in
      let rec aux xs =
        match xs with
        | [] -> fail ()
        | (inits, rest) :: xs -> (
            match H.undo_ac_matching_nf tok op inits with
            | Some op_bs' ->
                m_expr xa op_bs'
                >>= (fun () -> m_assoc_op tok op xsa rest)
                >||> aux xs
            | None -> aux xs)
      in
      aux candidates
  | { e = G.Ellipsis i; _ } :: xsa, xb :: xsb ->
      (* can match nothing *)
      m_assoc_op tok op xsa (xb :: xsb)
      >||> (* can match more *)
      m_assoc_op tok op ((G.Ellipsis i |> G.e) :: xsa) xsb
  | xa :: xsa, xb :: xsb ->
      let* () = m_expr xa xb in
      m_assoc_op tok op xsa xsb
  | _ :: _, []
  | [], _ :: _ ->
      fail ()

(* Associative-Commutative (AC) matching of operators.
 *
 * This for example, will successfully match `a && b && c` against `b && a && c`!
 * It will also match `if (<... b && c ...>) ...` against `if (a && b && c) S`
 * which was not matching before as `a && b && c` is parsed as `(a && b) && c`.
 *
 * NOTE: There is not need for supporting $...MVAR here, and strictly speaking
 *   it doesn't apply either since we still see the operator as binary.
 *
 * BEHAVIOR ISSUES:
 *
 * Even without a deep-expr pattern, `if (b && c) ...` will also match
 * `if (a && b && c) S`. That is, there is an implicit `op ...` added to AC
 * operators. Why? Let's say that we want to match pattern `<... a && b ...>`
 * against `a && (b && c)`, the sub-expressions of `a && (b && c)` are itself,
 * `a`, `b && c`, `b`, and `c`. The only chance to match `a && b` is to do it
 * on `a && (b && c)`, and for that to work we cannot fail when there are
 * operands left to match. TODO: We could try to detect when the AC op-pattern
 * occurs inside a deep-expr and only then assume an implicit `&& ...`.
 *
 * AC-matching of metavariables could lead to some strange behaviors given that
 * we work with ranges. E.g. we can match `a && $X` against `b && a && c` by
 * binding $X to `b && c`, but the range of $X will be that of the whole
 * `b && a && c` expression. Eventually, if we switch to work with the sub-ASTs
 * matched by patterns rather than with their ranges, this will stop being a
 * problem. In the meantime, one can disable AC-matching per rule.
 *
 * Autofix will probably not work well with AC-matching either.
 *
 * PERFORMANCE ISSUES:
 *
 * Note that AC-matching is an NP-complete problem. This is a naive
 * implementation with lots of dumb combinatorial search. We only use
 * AC-matching when we expect it to be fast, otherwise we fall-back to
 * regular non-AC matching.
 *
 * For a more efficient AC matching algorithm, see paper by Steven M. Eker:
 *
 *     "Associative-Commutative Matching Via Bipartite Graph Matching"
 *)
and m_ac_op tok op aargs_ac bargs_ac =
  (* Partitition aargs_ac to separate metavariables and ellipsis (avars) from
   * non-mvar-ish expressions (aapps). *)
  let avars, aapps =
    aargs_ac
    |> List.partition (fun e ->
           match e.G.e with
           | G.Ellipsis _ -> true
           | G.N (G.Id ((str, _tok), _id_info)) -> Mvar.is_metavar_name str
           | ___else___ -> false)
  in
  (* Try to match each aapp with a different barg, this is a 1-to-1 matching.
   * Here we don't expect perf issues on real code, because each aapp will
   * typically only match one bargs_ac, so there should be no combinatorial
   * explosion. Of course one can construct a synthetic example that explodes!
   * E.g. matching a long pattern `A && B && ...` against a very long decision
   * `A && ... && A && B && ... && B && ...` could explode.
   *)
  let bs_left =
    match aapps with
    (* if there are no aapps we don't want to fail *)
    | [] -> m_comb_unit bargs_ac
    | _ -> m_comb_unit bargs_ac |> m_comb_fold (m_comb_1to1 m_expr) aapps
  in
  (* Try to match each variable with a unique disjoint subset of the remaining
   * bs_left, ellipsis (`...`) can match the empty set. This can easily
   * explode so we only perform full AC matching for variables when the
   * number of bs left to match (num_bs_left) is small. Note that an mvar will
   * typically match all subsets of the bs left!!! *)
  let num_bs_left = List.length bargs_ac - List.length aapps in
  let avars_no_end_dots =
    (* An ending ellipsis (...) can be removed without affecting the result
     * but reducing duplicates and improving perf. *)
    match List.rev avars with
    | { e = G.Ellipsis _; _ } :: rev_avars -> List.rev rev_avars
    | ____else____ -> avars
  in
  match avars_no_end_dots with
  (* Nothing to do here, just return. *)
  | [] -> m_comb_flatten bs_left
  | ___many___ when num_bs_left <= 3 ->
      (* AC matching, it explodes easily so use with care! *)
      let m_var x bs' =
        (* `...` can match the empty set, whereas `$MVAR` must much something. *)
        match (x, H.undo_ac_matching_nf tok op bs') with
        | { G.e = G.Ellipsis _; _ }, None -> return ()
        | ___mvar___, None -> fail ()
        | ___mvar___, Some op_bs' -> m_expr x op_bs'
      in
      bs_left
      |> m_comb_fold (m_comb_1toN m_var) avars_no_end_dots
      |> m_comb_flatten
  | ___many___ ->
      (* FALLBACK: We add an ellipsis (`...`) at the end to make sure we match even if
       * there are more bs left than avars, and then we do regular non-AC matching.
       *
       * TODO: Could we first fallback to associative-only matching? It could still
       *       explode but not as easily
       *)
      (* TODO: Issue a proper warning to the user. *)
      Log.warn (fun m ->
          m
            "Restricted AC-matching due to potential blow-up: op=%s avars#=%d \
             bs_left#=%d\n"
            (G.show_operator op) (List.length avars) num_bs_left);
      m_comb_bind bs_left (fun bs' tin ->
          let avars_dots =
            avars_no_end_dots @ [ G.Ellipsis (G.fake "...") |> G.e ]
          in
          let tout =
            m_list__m_argument
              (List_.map G.arg avars_dots)
              (List_.map B.arg bs') tin
          in
          [ ([], tout) ])
      |> m_comb_flatten

(*****************************************************************************)
(* Type *)
(*****************************************************************************)
and m_type_ a b =
  Trace_matching.(if on then print_type_pair a b);
  let* () = m_attributes a.t_attrs b.t_attrs in
  match (a.t, b.t) with
  (* this must be before the next case, to prefer to bind metavars to
   * MV.Id (or MV.N) when we can, instead of the more general MV.T below *)
  | G.TyN a1, B.TyN b1
  (* JS/TS (and maybe other languages) allow arbitrary expressions to be used as
   * constructors (in `new X()`). The `X` ends up as a `TyExpr (N ...)` and is
   * then propagated via some rudimentary type inference. We still want it to
   * match e.g. typed metavariables, though, which are parsed as `TyN`, thus
   * this case.
   *
   * See the following for context about why this is done here, and not with
   * desugaring earlier in the pipeline:
   * - https://github.com/semgrep/semgrep/pull/5540
   * - https://github.com/semgrep/semgrep/pull/4682
   *)
  | G.TyN a1, B.TyExpr { e = N b1; _ } ->
      m_name a1 b1
  | G.TyN (G.Id ((str, tok), _id_info)), _t2 when Mvar.is_metavar_name str ->
      envf (str, tok) (MV.T b)
  (* dots: *)
  | G.TyEllipsis _, _ -> return ()
  (* boilerplate *)
  | G.TyFun (a1, a2), B.TyFun (b1, b2) ->
      m_parameter_list a1 b1 >>= fun () -> m_type_ a2 b2
  | G.TyArray (a1, a2), B.TyArray (b1, b2) ->
      m_bracket (m_option m_expr) a1 b1 >>= fun () -> m_type_ a2 b2
  | G.TyTuple a1, B.TyTuple b1 ->
      let partial_m_list_with_dots =
        m_list_with_dots m_type_ (function
          | { t = G.TyEllipsis _; _ } -> true
          | _ -> false)
      in
      (m_bracket (partial_m_list_with_dots ~less_is_ok:false)) a1 b1
  | G.TyAny a1, B.TyAny b1 -> m_tok a1 b1
  | G.TyApply (a1, a2), B.TyApply (b1, b2) ->
      m_type_ a1 b1 >>= fun () -> m_type_arguments a2 b2
  | G.TyVar a1, B.TyVar b1 -> m_ident a1 b1
  | G.TyPointer (a0, a1), B.TyPointer (b0, b1) ->
      m_tok a0 b0 >>= fun () -> m_type_ a1 b1
  | G.TyRef (a0, a1), B.TyRef (b0, b1) ->
      m_tok a0 b0 >>= fun () -> m_type_ a1 b1
  | G.TyQuestion (a1, a2), B.TyQuestion (b1, b2) ->
      m_type_ a1 b1 >>= fun () -> m_tok a2 b2
  | G.TyRest (a1, a2), B.TyRest (b1, b2) ->
      m_tok a1 b1 >>= fun () -> m_type_ a2 b2
  | G.TyRecordAnon (a0, a1), B.TyRecordAnon (b0, b1) ->
      let* () = m_class_kind a0 b0 in
      m_bracket m_fields a1 b1
  | G.TyOr (a1, a2, a3), B.TyOr (b1, b2, b3) ->
      m_type_ a1 b1 >>= fun () ->
      m_tok a2 b2 >>= fun () -> m_type_ a3 b3
  | G.TyAnd (a1, a2, a3), B.TyAnd (b1, b2, b3) ->
      m_type_ a1 b1 >>= fun () ->
      m_tok a2 b2 >>= fun () -> m_type_ a3 b3
  | G.TyExpr ({ e = DotAccess _; _ } as a1), B.TyN b1 -> (
      match H.name_of_dot_access a1 with
      | Some a1 -> m_name a1 b1
      | None -> fail ())
  | G.TyExpr a1, B.TyExpr b1 -> m_expr a1 b1
  | G.OtherType (a1, a2), B.OtherType (b1, b2) ->
      m_todo_kind a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.TyFun _, _
  | G.TyApply _, _
  | G.TyVar _, _
  | G.TyArray _, _
  | G.TyPointer _, _
  | G.TyTuple _, _
  | G.TyQuestion _, _
  | G.TyRest _, _
  | G.TyN _, _
  | G.TyAny _, _
  | G.TyOr _, _
  | G.TyAnd _, _
  | G.TyRecordAnon _, _
  | G.TyRef _, _
  | G.TyExpr _, _
  | G.OtherType _, _ ->
      fail ()

and m_type_arguments a b =
  match (a, b) with
  | a, b -> m_bracket (m_list m_type_argument) a b

and m_type_argument a b =
  match (a, b) with
  | B.TAExpr { e = N (Id ((str, tok), _)); _ }, G.TA b1
    when Mvar.is_metavar_name str ->
      envf (str, tok) (MV.T b1)
  | G.TA a1, B.TA b1 -> m_type_ a1 b1
  | G.TAWildcard (a1, a2), B.TAWildcard (b1, b2) ->
      let* () = m_tok a1 b1 in
      m_option m_wildcard a2 b2
  | G.TAExpr a1, B.TAExpr b1 -> m_expr a1 b1
  | G.OtherTypeArg (a1, a2), B.OtherTypeArg (b1, b2) ->
      m_todo_kind a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.TA _, _
  | G.TAWildcard _, _
  | G.TAExpr _, _
  | G.OtherTypeArg _, _ ->
      fail ()

and m_todo_kind a b = m_ident a b

and m_wildcard (a1, a2) (b1, b2) =
  let* () = m_wrap m_bool a1 b1 in
  m_type_ a2 b2

(******************************************************************************)
(* Type.t, constructed during type inference and matched for typed metavariables
 * *)
(******************************************************************************)

(* The AST_generic.type_ written in a pattern vs an inferred Type.t
 *
 * Checks if the pattern `a` describes any supertype of the type `b`. Currently,
 * subtype analysis is fairly limited (I believe it only happens with
 * inheritance for nominal types when used with the Pro Engine) but it may be
 * extended at some point.
 *
 * Uses the provided `tok` (if any) when constructing synthetic AST to which a
 * metavariable is bound.
 * *)
and m_generic_type_vs_type_t lang tok a b =
  match (a.G.t, b) with
  | G.TyN (Id ((str, idtok), _)), _ when Mvar.is_metavar_name str -> (
      match
        Type.to_ast_generic_type_ ?tok:(Lazy.force tok) lang
          (fun name _alts -> name)
          b
      with
      | None ->
          (* Log error? Bind to OtherType? *)
          fail ()
      (* Ensure MV bindings are to Id or N as appropriate. THINK: Should this be
       * part of envf? *)
      | Some { G.t = G.TyN (Id (id, info)); _ } ->
          envf (str, idtok) (MV.Id (id, Some info))
      | Some { G.t = G.TyN name; _ } -> envf (str, idtok) (MV.N name)
      | Some ty -> envf (str, idtok) (MV.T ty))
  | G.TyN name1, Type.N ((name2, (* targs *) []), _alts) ->
      (* TODO: Alternate names should actually be part of the 'resolved type
       * param in Type.t. They are actually stored in the name, so we ignore
       * them here. *)
      m_name name1 name2
  | G.TyApply ({ t = G.TyN name1; _ }, targs1), Type.N ((name2, targs2), _alts)
    ->
      let* () = m_name name1 name2 in
      m_generic_targs_vs_type_targs lang tok targs1 targs2
  (* TODO: Handle IdQualified matching unresolved name? *)
  | G.TyN (Id ((str1, _), _)), Type.UnresolvedName (str2, (* targs *) []) ->
      m_string str1 str2
  | ( G.TyApply ({ t = G.TyN (Id ((str1, _), _)); _ }, targs1),
      Type.UnresolvedName (str2, targs2) ) ->
      let* () = m_string str1 str2 in
      m_generic_targs_vs_type_targs lang tok targs1 targs2
  | G.TyN (Id ((str, _), _)), Type.Builtin builtin2 -> (
      (* Convert the string in the pattern to a Type.builtin_type. Currently,
       * this lets users write, for example `str` in Java and have it
       * interpreted as `String`. We could make this a bit stricter, but some
       * tests rely on this behavior and real rules probably do as well. It's
       * probably fine to be a bit generous here when we're attempting a match
       * against a builtin, as this will not preclude matches elsewhere against
       * named types that happen to collide. *)
      match (Type.builtin_type_of_string lang str, builtin2) with
      | Some Type.Int, Type.Int
      | Some Type.Float, Type.Float
      | Some Type.String, Type.String
      | Some Type.Bool, Type.Bool
      (* Type.Number used for JS/TS. We still infer more specific types for
       * literals, however. *)
      | Some Type.Number, (Type.Number | Type.Int | Type.Float) ->
          return ()
      | Some Type.Int, _
      | Some Type.Float, _
      | Some Type.String, _
      | Some Type.Bool, _
      | Some Type.Number, _
      | Some (Type.OtherBuiltins _), _
      | None, _ ->
          fail ())
  (* coupling: we also match on "null" etc. in Typing.type_of_ast_generic_type.
   * Pull out into util? *)
  | G.TyN (Id ((("null" | "nil" | "NULL"), _), _)), Type.Null -> return ()
  (* An array type pattern with no size specified should still match an array
   * type where we know the size. *)
  | G.TyArray ((_l, None, _r), t1), Type.Array (_size, t2) ->
      (* THINK: Should be an invariant match rather than covariant? *)
      m_generic_type_vs_type_t lang tok t1 t2
  | ( G.TyArray ((_l, Some { e = G.L (G.Int pi1); _ }, _r), t1),
      Type.Array (Some pi2, t2) ) ->
      let* () = m_parsed_int pi1 pi2 in
      (* THINK: Should be an invariant match rather than covariant? *)
      m_generic_type_vs_type_t lang tok t1 t2
  | G.TyFun (params1, tret1), Type.Function (params2, tret2) ->
      let* () = m_generic_params_vs_params lang tok params1 params2 in
      m_generic_type_vs_type_t lang tok tret1 tret2
  | G.TyPointer (_tok, t1), Type.Pointer t2 ->
      m_generic_type_vs_type_t lang tok t1 t2
  | G.TyExpr { e = G.N name1; _ }, _ ->
      m_generic_type_vs_type_t lang tok (G.TyN name1 |> G.t) b
  | _, Type.N _
  | _, Type.UnresolvedName _
  | _, Type.Builtin _
  | _, Type.Null
  | _, Type.Array _
  | _, Type.Function _
  | _, Type.Pointer _
  | _, Type.NoType
  | _, Type.Todo _ ->
      fail ()

and m_generic_targs_vs_type_targs lang tok (_l, a, _r) b =
  (* TODO Handle ellipses? *)
  m_list (m_generic_targ_vs_type_targ lang tok) a b

and m_generic_targ_vs_type_targ lang tok a b =
  match (a, b) with
  | G.TA t1, Type.TA t2 ->
      (* Technically this isn't quite right. m_generic_type_vs_type_t checks if
       * t1 is a supertype of t2. Typically, type parameters must be invariant,
       * and this will assume covariance. But it's probably not a big deal, and
       * they don't have to be invariant in all cases anyway. *)
      m_generic_type_vs_type_t lang tok t1 t2
  (* TODO equivalence between Java `List<?>` and `List<? extends Object>`? *)
  | G.TAWildcard (_, None), Type.TAWildcard None -> return ()
  | G.TAWildcard (_, Some kinda), Type.TAWildcard (Some kindb) -> (
      match (kinda, kindb) with
      | ((false, _), t1), Type.TAUpper t2
      | ((true, _), t1), Type.TALower t2 ->
          m_generic_type_vs_type_t lang tok t1 t2
      | _, Type.TAUpper _
      | _, Type.TALower _ ->
          fail ())
  | G.TA _, Type.TAWildcard _
  | G.TA _, Type.OtherTypeArg _
  (* TODO Represent more typearg kinds in Type.t? *)
  | G.TAWildcard _, _
  | G.TAExpr _, _
  (* THINK: Should G.OtherTypeArg match Type.OtherTypeArg? *)
  | G.OtherTypeArg _, _ ->
      fail ()

and m_generic_params_vs_params lang tok a b =
  (* TODO Handle ellipses? *)
  m_list (m_generic_param_vs_param lang tok) a b

and m_generic_param_vs_param lang tok a b =
  match (a, b) with
  | ( G.Param { G.pname = name1; ptype = t1; _ },
      Type.Param { Type.pident = name2; ptype = t2 } ) -> (
      let name1 = Option.map fst name1 in
      let* () = m_option m_string name1 name2 in
      match t1 with
      | Some t1 -> m_generic_type_vs_type_t lang tok t1 t2
      | None -> (* THINK: Is this right? *) return ())
  | _, Type.Param _
  | _, Type.OtherParam _ ->
      fail ()

(*****************************************************************************)
(* Attribute *)
(*****************************************************************************)
and m_keyword_attribute a b =
  match (a, b) with
  | G.Var, B.Var -> return ()
  (* equivalent: quite JS-specific *)
  | G.Var, (B.Let | B.Const) ->
      if_config (fun x -> x.let_is_var) ~then_:(return ()) ~else_:(fail ())
  | _ -> m_other_xxx a b

and m_attribute a b =
  match (a, b) with
  (* boilerplate *)
  | G.KeywordAttr a1, B.KeywordAttr b1 -> m_wrap m_keyword_attribute a1 b1
  | G.NamedAttr (a0, a1, a2), B.NamedAttr (b0, b1, b2) ->
      m_tok a0 b0 >>= fun () ->
      (* 'm_name' handles aliasing for attributes! *)
      m_name a1 b1 >>= fun () -> m_bracket m_list__m_argument a2 b2
  | G.OtherAttribute (a1, a2), B.OtherAttribute (b1, b2) ->
      m_todo_kind a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | ( G.OtherAttribute (_, [ G.E { e = G.Call (a1, a2); _ } ]),
      B.NamedAttr (_, b1, b2) ) ->
      m_expr a1 (B.N b1 |> B.e) >>= fun () -> m_bracket m_list__m_argument a2 b2
  | ( G.NamedAttr (_, a1, a2),
      B.OtherAttribute (_, [ B.E { e = B.Call (b1, b2); _ } ]) ) ->
      m_expr (G.N a1 |> G.e) b1 >>= fun () -> m_bracket m_list__m_argument a2 b2
  | G.KeywordAttr _, _
  | G.NamedAttr _, _
  | G.OtherAttribute _, _ ->
      fail ()

and m_attributes a b =
  if_config
    (fun x -> x.decorators_order_matters)
    ~then_:
      ((* there is a need for specifying the order of non-keyword attributes (NamedAttr + OtherAttribute),
        * e.g. decorators in Python, but no evidence for that of keywords (KeywordAttr),
        * e.g. static inline vs inline static.
        * here, we partition the lists to process NameAttr + OtherAttribute and KeywordAttr differently
        *)
       let partition_keywords =
         List.partition (fun x ->
             match x with
             | G.KeywordAttr _ -> true
             | _ -> false)
       in
       let a_keywords, a_others = partition_keywords a in
       let b_keywords, b_others = partition_keywords b in
       let* () = m_list_subsequence m_attribute a_others b_others in
       let* () =
         m_list_in_any_order ~less_is_ok:true m_attribute a_keywords b_keywords
       in
       return ())
    ~else_:(m_list_in_any_order ~less_is_ok:true m_attribute a b)

(*****************************************************************************)
(* Implicit return *)
(*****************************************************************************)
(* For matching `return a` with `b` when `b` is the last executed expression
 * in a function. Here, `a` must come from a return statement.
 *)
and m_implicit_return (a : G.expr) (b : B.expr) tin =
  if tin.config.implicit_return && b.is_implicit_return then m_expr_root a b tin
  else fail () tin

(*****************************************************************************)
(* Statement list *)
(*****************************************************************************)
(* possibly go deeper when someone wants that a pattern like
 *   ...
 *   bar();
 * to match also calls to bar() deeply as in
 *   foo();
 *   if(true)
 *      bar();
 *
 * When combined with the deep expr, this even allows to match code like
 *  if(true)
 *     x = bar();
 *
 * This is currently very hacky. We just flatten the list of all substmts.
 *
 * alternatives:
 *   - do it the right way by having '...' work on control-flow paths as in
 *     coccinelle
 *
 * todo? we could restrict ourselves to only a few forms?
 *)
and m_stmts_deep ~inside ~less_is_ok (xsa : G.stmt list) (xsb : G.stmt list) =
  (* opti: this was the old code:
   *   if !Flag.go_deeper_stmt && (has_ellipsis_stmts xsa)
   *   then
   *   m_list__m_stmt xsa xsb >!> (fun () ->
   *     let xsb' = SubAST_generic.flatten_substmts_of_stmts xsb in
   *     m_list__m_stmt xsa xsb'
   *   )
   *   else m_list__m_stmt xsa xsb
   *
   * but this was really slow on huge files because with a pattern like
   * 'foo(); ...; bar();' we would call flatten_substmts_of_stmts
   * on each sequences in the program, even though foo(); was not
   * matched first.
   * Better to first match the first element, and if it matches and
   * we have a '...' that was not matched on the current sequence,
   * then we try with flatten_substmts_of_stmts.
   *
   * The code below is mostly a copy paste of m_list__m_stmt. We could
   * factorize, but I prefer to control and limit the number of places
   * where we call m_stmts_deep. Once we call m_list__m_stmt, we
   * are in a simpler world where the list of stmts will not grow.
   *)
  match (xsa, xsb) with
  | [], [] -> return ()
  (* less-is-ok:
   * it's ok to have statements after in the concrete code as long as we
   * matched all the statements in the pattern (there is an implicit
   * '...' at the end, in addition to implicit '...' at the beginning
   * handled by kstmts calling the pattern for each subsequences).
   * TODO: sgrep_generic though then display the whole sequence as a match
   * instead of just the relevant part.
   *)
  | [], _ :: _ -> if less_is_ok then return () else fail ()
  (* dots: '...', can also match no statement *)
  | [ { s = G.ExprStmt ({ e = G.Ellipsis _i; _ }, _); _ } ], [] -> return ()
  (* inside:
   * When a pattern-inside (or pattern-not-inside) ends in ... we do not
   * need to compute all possible endings, it's enough to return the largest
   * one. If some other pattern P matches inside the largest match here, then
   * that is enough to either keep P (pattern-inside) or filter it out
   * (pattern-not-inside).
   *)
  | [ { s = G.ExprStmt ({ e = G.Ellipsis _i; _ }, _); _ } ], xb :: bbs
    when inside ->
      env_add_matched_stmt xb >>= fun () ->
      m_stmts_deep ~inside ~less_is_ok xsa bbs
  | ( ({ s = G.ExprStmt ({ e = G.Ellipsis _i; _ }, _); _ } :: _ as xsa),
      (_ :: _ as xsb) ) ->
      m_list__m_stmt xsa xsb
      >||> if_config
             (fun x -> x.go_deeper_stmt)
             ~then_:
               (match SubAST_generic.flatten_substmts_of_stmts xsb with
               | None -> fail () (* was already flat *)
               | Some (xsb, _UNUSED_last_stmt) -> m_list__m_stmt xsa xsb)
             ~else_:(fail ())
  (* dots: metavars: $...BODY *)
  | ( ({ s = G.ExprStmt ({ e = G.N (G.Id ((s, _), _idinfo)); _ }, _); _ } :: _
       as xsa),
      xsb )
    when Mvar.is_metavar_ellipsis s ->
      (* less: for metavariable ellipsis, does it make sense to go deep? *)
      m_list__m_stmt xsa xsb
  (* the general case *)
  | xa :: aas, xb :: bbs ->
      m_stmt xa xb >>= fun () ->
      env_add_matched_stmt xb >>= fun () ->
      m_stmts_deep ~inside ~less_is_ok aas bbs
  | _ :: _, _ -> fail ()

(* TODO: factorize with m_list_and_dots less_is_ok = true *)
(* coupling: many of the cases below are similar to the one in
 * m_stmts_deep.
 * TODO? can we remove the duplication
 *)
and m_list__m_stmt ?(less_is_ok = true) (xsa : G.stmt list) (xsb : G.stmt list)
    =
  Log.debug (fun m ->
      m "%s"
        (spf "m_list__m_stmt: %d vs %d" (List.length xsa) (List.length xsb)));
  match (xsa, xsb) with
  | [], [] -> return ()
  (* less-is-ok:
   * it's ok to have statements after in the concrete code as long as we
   * matched all the statements in the pattern (there is an implicit
   * '...' at the end, in addition to implicit '...' at the beginning
   * handled by kstmts calling the pattern for each subsequences).
   * TODO: sgrep_generic though then display the whole sequence as a match
   * instead of just the relevant part.
   *)
  | [], _ :: _ -> if less_is_ok then return () else fail ()
  (* dots: '...', can also match no statement *)
  | [ { s = G.ExprStmt ({ e = G.Ellipsis _i; _ }, _); _ } ], [] -> return ()
  | ( { s = G.ExprStmt ({ e = G.Ellipsis _i; _ }, _); _ } :: xsa_tail,
      (xb :: xsb_tail as xsb) ) ->
      (* can match nothing *)
      m_list__m_stmt xsa_tail xsb
      >||> (* can match more *)
      (env_add_matched_stmt xb >>= fun () -> m_list__m_stmt xsa xsb_tail)
  (* dots: metavars: $...BODY *)
  | ( { s = G.ExprStmt ({ e = G.N (G.Id ((s, tok), _idinfo)); _ }, _); _ } :: xsa,
      xsb )
    when Mvar.is_metavar_ellipsis s ->
      (* can match 0 or more arguments *)
      let candidates = inits_and_rest_of_list_empty_ok xsb in
      let rec aux xs =
        match xs with
        | [] -> fail ()
        | (inits, rest) :: xs ->
            envf (s, tok) (MV.Ss inits)
            >>= (fun () ->
                  (* If we don't do this, patterns ending in an ellipsis metavariable, like:
                     x = 1
                     $...STMTS
                     will not properly extend the range of the match with whatever $...STMTS
                     matches.
                  *)
                  match List_.last_opt inits with
                  | None -> m_list__m_stmt ~less_is_ok:false xsa rest
                  | Some last ->
                      env_add_matched_stmt last >>= fun () ->
                      (* when we use { $...BODY }, we don't have an implicit
                         * ... after, so we use less_is_ok:false here
                      *)
                      m_list__m_stmt ~less_is_ok:false xsa rest)
            >||> aux xs
      in
      aux candidates
  (* the general case *)
  | xa :: aas, xb :: bbs ->
      m_stmt xa xb >>= fun () ->
      env_add_matched_stmt xb >>= fun () -> m_list__m_stmt aas bbs
  | _ :: _, _ -> fail ()

(*****************************************************************************)
(* Statement *)
(*****************************************************************************)
and m_stmt a b =
  Trace_matching.(if on then print_stmt_pair a b);
  match (a.s, b.s) with
  (* the order of the matches matters! take care! *)
  (* equivalence: user-defined equivalence! *)
  | G.DisjStmt (a1, a2), _b -> m_stmt a1 b >||> m_stmt a2 b
  (* useful to test error management around unexpected failures
   * (see test_semgrep_core_error.py).
   * Note that we do that in m_stmt instead of m_expr to reduce the number
   * of those checks (hopefuly OCaml pattern matching compiler does a good job).
   *)
  | ( _,
      G.ExprStmt
        ( {
            e =
              G.Call
                ({ e = G.N (G.Id (("r_2_c_was_fatal", _), _)); _ }, (_, [], _));
            _;
          },
          _sc ) ) ->
      failwith "r_2_c_was_fatal"
  (* some marks in the water *)
  | ( _,
      G.ExprStmt
        ( {
            e =
              G.Call
                ({ e = G.N (G.Id (("r_2_c_was_here", _), _)); _ }, (_, [], _));
            _;
          },
          _sc ) ) ->
      return ()
  | ( _,
      G.ExprStmt
        ( {
            e =
              G.Call
                ( { e = G.N (G.Id (("r_2_c_pro_was_here", _), _)); _ },
                  (_, [], _) );
            _;
          },
          _sc ) )
    when !hook_r2c_pro_was_here =*= Some true ->
      return ()
  (* metavar: *)
  (* Note that we can't consider $S a statement metavariable only if the
   * semicolon is a fake one. Indeed in many places we have patterns
   * like 'if(...) $S;' because 'if(...) $S' would not parse.
   * alt: parse if(...) $S without the ending semicolon?
   * But at least we can try to match $S as a statement metavar
   * _or_ an expression metavar with >||>. below
   *)
  | G.ExprStmt (({ e = G.N (G.Id ((str, tok), _id_info)); _ } as suba), sc), _b
    when Mvar.is_metavar_name str -> (
      envf (str, tok) (MV.S b)
      >||>
      match b.s with
      | B.ExprStmt (subb, _) when not (Tok.is_fake sc) -> m_expr suba subb
      | _ -> fail ())
  (* dots: '...' can to match any statememt *)
  | G.ExprStmt ({ e = G.Ellipsis _i; _ }, _), _b -> return ()
  (* deep ellipsis as a statement should match any exprs in stmt *)
  | G.ExprStmt ({ e = G.DeepEllipsis (_, a, _); _ }, _), b ->
      let no_match _ _ = fail () in
      m_deep m_expr_deep no_match SubAST_generic.subexprs_of_stmt_kind a b
  | G.Return (a0, a1, asc), B.Return (b0, b1, bsc) ->
      let* () = m_tok a0 b0 in
      let* () = m_option_ellipsis_ok m_expr a1 b1 in
      m_tok asc bsc
  (* deeper: go deep by default implicitly *)
  | G.ExprStmt (a1, a2), B.ExprStmt (b1, b2) ->
      (* TODO: should make this an options: *)
      let* () =
        if_config
          (fun x -> x.implicit_deep_exprstmt)
          ~then_:(m_expr_deep_implict a1 b1)
          ~else_:(m_expr_root a1 b1)
      in
      m_tok a2 b2
  (* opti: specialization to avoid going in the deep stmt matching!
   * TODO: we should not need this; '...' should not enumerate all
   * possible subset of stmt list and take forever.
   * Note that as a side effect it returns also less equivalent
   * matches (which again, should not happen), which used to introduce
   * some regressions (see tests/rules/regression_uniq...) but this
   * has been fixed now.
   *)
  | ( G.Block (_, [ { s = G.ExprStmt ({ e = G.Ellipsis _i; _ }, _); _ } ], _),
      B.Block _b1 ) ->
      return ()
  (* opti: another specialization; again we should not need it *)
  | ( G.Block
        ( _,
          [
            { s = G.ExprStmt ({ e = G.Ellipsis _; _ }, _); _ };
            a;
            { s = G.ExprStmt ({ e = G.Ellipsis _; _ }, _); _ };
          ],
          _ ),
      B.Block (_, bs, _) ) ->
      let bs =
        match SubAST_generic.flatten_substmts_of_stmts bs with
        (* already flat  *)
        | None -> bs
        | Some (xs, _) -> xs
      in
      or_list m_stmt a bs
  (* the general case *)
  (* ... will now allow a subset of stmts (less_is_ok = false here) *)
  | G.Block a1, B.Block b1 ->
      m_bracket (m_stmts_deep ~inside:false ~less_is_ok:false) a1 b1
  (* equivalence: vardef ==> assign, and go deep.
   * coupling: with Visitor_AST.v_vardef_as_assign_expr which also deals with
   * vardef-assign equivalence. But the code there is useful when the pattern
   * is an expression and we want to visit also certain DefStmt as expressions.
   * Here instead, the pattern is a statement, so we need to duplicate the
   * logic.
   *)
  | ( G.ExprStmt (a1, _),
      B.DefStmt (ent, B.VarDef ({ B.vinit = Some _; _ } as def)) ) ->
      if_config
        (fun x -> x.vardef_assign)
        ~then_:
          (let b1 = H.vardef_to_assign (ent, def) in
           m_expr_deep a1 b1)
        ~else_:(fail ())
  (* coupling: with Visitor_AST.v_flddef_as_assign_expr *)
  | ( G.ExprStmt (({ G.e = Assign _; _ } as a1), _sc),
      B.DefStmt (ent, B.FuncDef fdef) ) ->
      if_config
        (fun x -> x.flddef_assign)
        ~then_:
          (let resolved = Some (G.LocalVar, G.SId.unsafe_default) in
           let b1 = H.funcdef_to_lambda (ent, fdef) resolved in
           m_expr_root a1 b1)
        ~else_:(fail ())
  (* equivalence: *)
  | G.ExprStmt (a1, _), B.Return (_, Some b1, _) -> m_expr_deep a1 b1
  (* implicit return *)
  | G.Return (_, Some a1, _), B.ExprStmt (b1, _) -> m_implicit_return a1 b1
  (* boilerplate *)
  | G.If (a0, a1, a2, a3), B.If (b0, b1, b2, b3) ->
      m_tok a0 b0 >>= fun () ->
      (* too many regressions doing m_expr_deep by default; Use DeepEllipsis *)
      m_condition a1 b1 >>= fun () ->
      m_block a2 b2 >>= fun () ->
      (* less-is-more: *)
      m_option_none_can_match_some m_block a3 b3
  | G.While (a0, a1, a2), B.While (b0, b1, b2) ->
      m_tok a0 b0 >>= fun () ->
      m_condition a1 b1 >>= fun () -> m_stmt a2 b2
  | G.DefStmt a1, B.DefStmt b1 -> m_definition a1 b1
  | G.DirectiveStmt a1, B.DirectiveStmt b1 -> m_directive a1 b1
  | G.DirectiveStmt a1, B.DefStmt b1 -> m_directive_vs_def a1 b1
  | G.DoWhile (a0, a1, a2), B.DoWhile (b0, b1, b2) ->
      m_tok a0 b0 >>= fun () ->
      m_stmt a1 b1 >>= fun () -> m_expr a2 b2
  | G.For (a0, a1, a2), B.For (b0, b1, b2) ->
      m_tok a0 b0 >>= fun () ->
      m_for_header a1 b1 >>= fun () -> m_stmt a2 b2
  | G.Switch (at, a1, a2), B.Switch (bt, b1, b2) ->
      m_tok at bt >>= fun () ->
      m_option m_condition a1 b1 >>= fun () -> m_case_clauses a2 b2
  | G.Continue (a0, a1, asc), B.Continue (b0, b1, bsc) ->
      let* () = m_tok a0 b0 in
      let* () = m_label_ident a1 b1 in
      m_tok asc bsc
  | G.Break (a0, a1, asc), B.Break (b0, b1, bsc) ->
      let* () = m_tok a0 b0 in
      let* () = m_label_ident a1 b1 in
      m_tok asc bsc
  | G.Label (a1, a2), B.Label (b1, b2) ->
      m_label a1 b1 >>= fun () -> m_stmt a2 b2
  | G.Goto (a0, a1, asc), B.Goto (b0, b1, bsc) ->
      let* () = m_tok a0 b0 in
      let* () = m_label a1 b1 in
      m_tok asc bsc
  | G.Throw (a0, a1, asc), B.Throw (b0, b1, bsc) ->
      let* () = m_tok a0 b0 in
      let* () = m_expr a1 b1 in
      m_tok asc bsc
  | G.Try (a0, a1, a2, a3, a4), B.Try (b0, b1, b2, b3, b4) ->
      let* () = m_tok a0 b0 in
      let* () = m_stmt a1 b1 in
      let* () = (m_list_in_any_order ~less_is_ok:true m_catch) a2 b2 in
      let* () = (m_option m_try_else) a3 b3 in
      (m_option m_finally) a4 b4
  | G.Assert (a0, aargs, asc), B.Assert (b0, bargs, bsc) ->
      let* () = m_tok a0 b0 in
      let* () = m_arguments aargs bargs in
      m_tok asc bsc
  | G.OtherStmt (a1, a2), B.OtherStmt (b1, b2) ->
      m_other_stmt_operator a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.OtherStmtWithStmt (a1, a2, a3), B.OtherStmtWithStmt (b1, b2, b3) ->
      m_other_stmt_with_stmt_operator a1 b1 >>= fun () ->
      m_list m_any a2 b2 >>= fun () -> m_stmt a3 b3
  | G.RawStmt a, B.RawStmt b -> m_raw_tree a b
  | G.WithUsingResource (a1, a2, a3), B.WithUsingResource (b1, b2, b3) ->
      m_tok a1 b1 >>= fun () ->
      m_list m_stmt a2 b2 >>= fun () -> m_stmt a3 b3
  | G.ExprStmt _, _
  | G.DefStmt _, _
  | G.DirectiveStmt _, _
  | G.Block _, _
  | G.If _, _
  | G.While _, _
  | G.DoWhile _, _
  | G.For _, _
  | G.Switch _, _
  | G.Return _, _
  | G.Continue _, _
  | G.Break _, _
  | G.Label _, _
  | G.Goto _, _
  | G.Throw _, _
  | G.Try _, _
  | G.Assert _, _
  | G.OtherStmt _, _
  | G.OtherStmtWithStmt _, _
  | G.RawStmt _, _
  | G.WithUsingResource _, _ ->
      fail ()

and m_condition a b =
  match (a, b) with
  | G.Cond a1, B.Cond b1 -> m_expr a1 b1
  | G.OtherCond (a1, a2), B.OtherCond (b1, b2) ->
      let* () = m_todo_kind a1 b1 in
      let* () = m_list m_any a2 b2 in
      return ()
  | G.Cond _, _
  | G.OtherCond _, _ ->
      fail ()

and m_case_clauses a b =
  let _has_ellipsis, a =
    has_ellipsis_and_filter_ellipsis_gen
      (function
        | G.CaseEllipsis _ -> true
        | _ -> false)
      a
  in
  (* todo? always implicit ...?
   * todo? do in any order? In theory the order of the cases matter, but
   * in a semgrep context, people probably don't want to find
   * specific cases in a specific order.
   *)
  m_list_in_any_order ~less_is_ok:true m_case_and_body a b

and m_for_header a b =
  match (a, b) with
  (* dots: *)
  | G.ForEllipsis _, _ -> return ()
  | G.ForClassic (a1, a2, a3), B.ForClassic (b1, b2, b3) ->
      (m_list m_for_var_or_expr) a1 b1 >>= fun () ->
      m_option m_expr a2 b2 >>= fun () -> m_option m_expr a3 b3
  | G.ForEach a1, B.ForEach b1 -> m_for_each a1 b1
  | G.MultiForEach a1, B.MultiForEach b1 ->
      m_list_with_dots ~less_is_ok:false m_multi_for_each
        (function
          | G.FEllipsis _ -> true
          | _ -> false)
        a1 b1
  | G.ForClassic _, _
  | G.ForEach _, _
  | G.MultiForEach _, _ ->
      fail ()

and m_for_each (a1, at, a2) (b1, bt, b2) =
  m_pattern a1 b1 >>= fun () ->
  m_tok at bt >>= fun () -> m_expr a2 b2

and m_multi_for_each a b =
  match (a, b) with
  | G.FE a1, B.FE b1 -> m_for_each a1 b1
  | G.FECond (a1, at, a2), B.FECond (b1, bt, b2) ->
      m_for_each a1 b1 >>= fun () ->
      m_tok at bt >>= fun () -> m_expr a2 b2
  | G.FEllipsis _, _ -> return ()
  | _ -> fail ()

and m_block a b =
  match (a.s, b.s) with
  | G.Block _, B.Block _ -> m_stmt a b
  | G.Block (_, [ a_stmt ], _), _ -> m_stmt a_stmt b
  | _, B.Block (_, [ b_stmt ], _) -> m_stmt a b_stmt
  | _, _ -> m_stmt a b

and m_for_var_or_expr a b =
  match (a, b) with
  (* dots: *)
  | G.ForInitExpr { e = G.Ellipsis _; _ }, _ -> return ()
  | G.ForInitVar (a1, a2), B.ForInitVar (b1, b2) ->
      m_entity a1 b1 >>= fun () -> m_variable_definition a2 b2
  | G.ForInitExpr a1, B.ForInitExpr b1 -> m_expr a1 b1
  | G.ForInitVar _, _
  | G.ForInitExpr _, _ ->
      fail ()

and m_label a b =
  match (a, b) with
  | a, b -> m_ident a b

and m_catch a b =
  match (a, b) with
  | (at, a1, a2), (bt, b1, b2) ->
      m_tok at bt >>= fun () ->
      m_catch_exn a1 b1 >>= fun () -> m_stmt a2 b2

and m_catch_exn a b =
  match (a, b) with
  (* dots: *)
  | G.CatchPattern (G.PatEllipsis _), _ -> return ()
  (* boilerplate *)
  | G.CatchPattern a, CatchPattern b -> m_pattern a b
  | G.CatchParam a, B.CatchParam b -> m_parameter_classic a b
  | G.OtherCatch (a0, a1), B.OtherCatch (b0, b1) ->
      let* () = m_todo_kind a0 b0 in
      m_list m_any a1 b1
  | G.CatchPattern _, _
  | G.OtherCatch _, _
  | G.CatchParam _, _ ->
      fail ()

and m_try_else a b =
  match (a, b) with
  | (at, a), (bt, b) -> m_tok at bt >>= fun () -> m_stmt a b

and m_finally a b =
  match (a, b) with
  | (at, a), (bt, b) -> m_tok at bt >>= fun () -> m_stmt a b

and m_case_and_body a b =
  match (a, b) with
  | CasesAndBody (a1, a2), CasesAndBody (b1, b2) ->
      (m_list m_case) a1 b1 >>= fun () -> m_stmt a2 b2
  | CaseEllipsis _, CasesAndBody _ -> return ()
  | CasesAndBody _, _
  | CaseEllipsis _, _ ->
      fail ()

and m_case a b =
  match (a, b) with
  | G.Case (a0, a1), B.Case (b0, b1) ->
      m_tok a0 b0 >>= fun () -> m_pattern a1 b1
  | G.CaseEqualExpr (a0, a1), B.CaseEqualExpr (b0, b1) ->
      m_tok a0 b0 >>= fun () -> m_expr a1 b1
  | G.Default a0, B.Default b0 -> m_tok a0 b0
  | G.OtherCase (a0, a1), B.OtherCase (b0, b1) ->
      let* () = m_todo_kind a0 b0 in
      m_list m_any a1 b1
  | G.Case _, _
  | G.Default _, _
  | G.CaseEqualExpr _, _
  | G.OtherCase _, _ ->
      fail ()

and m_other_stmt_operator = m_other_xxx

and m_other_stmt_with_stmt_operator a b =
  match (a, b) with
  | G.OSWS_With, G.OSWS_With
  | G.OSWS_Else_in_try, G.OSWS_Else_in_try
  | G.OSWS_Iterator, G.OSWS_Iterator
  | G.OSWS_SEH, G.OSWS_SEH
  | G.OSWS_Todo, G.OSWS_Todo ->
      return ()
  | G.OSWS_Block a, G.OSWS_Block b -> m_todo_kind a b
  | G.OSWS_With, _
  | G.OSWS_Block _, _
  | G.OSWS_Else_in_try, _
  | G.OSWS_Iterator, _
  | G.OSWS_SEH, _
  | G.OSWS_Todo, _ ->
      fail ()

(*****************************************************************************)
(* Pattern *)
(*****************************************************************************)
and m_pattern a b =
  match (a, b) with
  (* equivalence: user-defined equivalence! *)
  | G.DisjPat (a1, a2), b -> m_pattern a1 b >||> m_pattern a2 b
  (* metavar: *)
  (* less: G.PatId vs B.PatId? Use MV.Id then ? *)
  | G.PatId ((str, tok), _id_info), b2 when Mvar.is_metavar_name str -> (
      try
        let e2 = H.pattern_to_expr b2 in
        envf (str, tok) (MV.E e2)
        (* this can happen with PatAs in exception handler in Python *)
      with
      | H.NotAnExpr -> envf (str, tok) (MV.P b2))
  (* dots: *)
  | G.PatEllipsis _, _ -> return ()
  (* boilerplate *)
  | G.PatId (a1, a2), B.PatId (b1, b2) ->
      m_ident a1 b1 >>= fun () -> m_id_info a2 b2
  | G.PatLiteral a1, B.PatLiteral b1 -> m_literal a1 b1
  | G.PatType a1, B.PatType b1 -> m_type_ a1 b1
  | G.PatConstructor (a1, a2), B.PatConstructor (b1, b2) ->
      m_name a1 b1 >>= fun () ->
      (m_list_with_dots ~less_is_ok:false m_pattern (function
        | G.PatEllipsis _ -> true
        | _ -> false))
        a2 b2
  | G.PatTuple a1, B.PatTuple b1 -> m_bracket (m_list m_pattern) a1 b1
  | G.PatList a1, B.PatList b1 -> m_bracket (m_list m_pattern) a1 b1
  | G.PatRecord a1, B.PatRecord b1 -> m_bracket (m_list m_field_pattern) a1 b1
  | G.PatKeyVal (a1, a2), B.PatKeyVal (b1, b2) ->
      m_pattern a1 b1 >>= fun () -> m_pattern a2 b2
  | G.PatWildcard a1, B.PatWildcard b1 -> m_tok a1 b1
  | G.PatDisj (a1, a2), B.PatDisj (b1, b2) ->
      m_pattern a1 b1 >>= fun () -> m_pattern a2 b2
  | G.PatAs (a1, (a2, a3)), B.PatAs (b1, (b2, b3)) ->
      m_pattern a1 b1 >>= fun () -> m_ident_and_id_info (a2, a3) (b2, b3)
  | G.PatTyped (a1, a2), B.PatTyped (b1, b2) ->
      m_pattern a1 b1 >>= fun () -> m_type_ a2 b2
  | G.PatWhen (a1, a2), B.PatWhen (b1, b2) ->
      m_pattern a1 b1 >>= fun () -> m_expr a2 b2
  | G.OtherPat (a1, a2), B.OtherPat (b1, b2) ->
      m_todo_kind a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.PatId _, _
  | G.PatLiteral _, _
  | G.PatConstructor _, _
  | G.PatTuple _, _
  | G.PatList _, _
  | G.PatRecord _, _
  | G.PatKeyVal _, _
  | G.PatWildcard _, _
  | G.PatDisj _, _
  | G.PatWhen _, _
  | G.PatAs _, _
  | G.PatTyped _, _
  | G.OtherPat _, _
  | G.PatType _, _ ->
      fail ()

and m_field_pattern a b =
  match (a, b) with
  | (a1, a2), (b1, b2) -> m_dotted_name a1 b1 >>= fun () -> m_pattern a2 b2

(*****************************************************************************)
(* Definitions *)
(*****************************************************************************)
and m_definition a b =
  Trace_matching.(if on then print_definition_pair a b);
  match (a, b) with
  | (a1, a2), (b1, b2) ->
      (* subtle: if you change the order here, so that we execute m_entity
       * only when the definition_kind matches, this helps to avoid
       * calls to ocamllsp when you put a type constraint on a function.
       * Indeed, we will call ocamllsp only for FuncDef.
       * This also avoids to call ocamllsp on type definition entities,
       * which can leads to errors in type_of_string.
       *)
      let* () = m_entity a1 b1 in
      let* () = m_definition_kind a2 b2 in
      return ()

and m_entity a b =
  match (a, b) with
  (* bugfix: when we use a metavar to match an entity, as in $X(...): ...
   * and later we use $X again to match a name, the $X is first an ident and
   * later an expression, which would prevent a match. Instead we need to
   * make $X an expression early on.
   * update: actually better to use a special MV.Id for that.
   *)
  | ( { G.name = a1; attrs = a2; tparams = a4 },
      { B.name = b1; attrs = b2; tparams = b4 } ) ->
      let* () = m_entity_name a1 b1 in
      let* () = m_attributes a2 b2 in
      (* less-is-more: *)
      m_option_none_can_match_some (m_bracket m_list__m_type_parameter) a4 b4

and m_list__m_type_parameter a b =
  match a with
  (* less-is-ok: it's ok to not have generics at all in the pattern.
   * TODO? or should we impose that the entity name above is a metavariable?
   * and then bind it to an IdQualifier with a type_argument?
   *)
  | [] -> return ()
  | _ ->
      m_list_with_dots m_type_parameter
        (function
          | G.TParamEllipsis _ -> true
          | _ -> false)
        ~less_is_ok:false (* empty list can not match non-empty list *) a b

and m_definition_kind a b =
  match (a, b) with
  (* We maintain an equivalence between a FieldDefColon of an ellipsis
     with any other definition. This is because FieldDefColon appears
     when describing the RHS of a record, so this describes a record
     like
     { x = ... }
     The FieldDefColon case is matched as different than other
     `definition_kind` structures, like a `FuncDef`, so we
     have to explicitly whitelist it so that we can match those with the
     ellipsis.

     A concrete example is TS, when you have
     { func: function (opts) { return "whatever"; } }
     which is a record containing an entry which is a `FuncDef`.

     For now, we only whitelist the FuncDef case.
  *)
  | G.FieldDefColon { vinit = Some { e = Ellipsis _; _ }; _ }, B.FuncDef _ ->
      return ()
  (* boilerplate *)
  | G.EnumEntryDef a1, B.EnumEntryDef b1 -> m_enum_entry_definition a1 b1
  | G.FuncDef a1, B.FuncDef b1 -> m_function_definition a1 b1
  | G.VarDef a1, B.VarDef b1 -> m_variable_definition a1 b1
  | G.FieldDefColon a1, B.FieldDefColon b1 -> m_variable_definition a1 b1
  | G.ClassDef a1, B.ClassDef b1 -> m_class_definition a1 b1
  | G.TypeDef a1, B.TypeDef b1 -> m_type_definition a1 b1
  | G.ModuleDef a1, B.ModuleDef b1 -> m_module_definition a1 b1
  | G.MacroDef a1, B.MacroDef b1 -> m_macro_definition a1 b1
  | G.Signature a1, B.Signature b1 -> m_signature_definition a1 b1
  | G.UseOuterDecl a1, B.UseOuterDecl b1 -> m_tok a1 b1
  | G.OtherDef (a1, a2), B.OtherDef (b1, b2) ->
      m_todo_kind a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.FuncDef _, _
  | G.VarDef _, _
  | G.ClassDef _, _
  | G.TypeDef _, _
  | G.ModuleDef _, _
  | G.MacroDef _, _
  | G.Signature _, _
  | G.UseOuterDecl _, _
  | G.FieldDefColon _, _
  | G.EnumEntryDef _, _
  | G.OtherDef _, _ ->
      fail ()

and m_enum_entry_definition a b =
  match (a, b) with
  | { G.ee_args = a1; ee_body = a2 }, { B.ee_args = b1; ee_body = b2 } ->
      let* () = m_option m_arguments a1 b1 in
      let* () = m_option (m_bracket m_fields) a2 b2 in
      return ()

and m_signature_definition a b =
  match (a, b) with
  | { G.sig_tok = a1; sig_type = a2 }, { B.sig_tok = b1; sig_type = b2 } ->
      let* () = m_tok a1 b1 in
      let* () = m_type_ a2 b2 in
      return ()

and m_type_parameter a b =
  match (a, b) with
  | G.TP a1, B.TP b1 -> m_type_parameter_classic a1 b1
  | G.OtherTypeParam (a1, a2), B.OtherTypeParam (b1, b2) ->
      m_todo_kind a1 b1 >>= fun () -> (m_list m_any) a2 b2
  (* those constructs should be handled in the caller *)
  | G.TParamEllipsis a1, B.TParamEllipsis b1 -> m_tok a1 b1
  | G.TP _, _
  | G.TParamEllipsis _, _
  | G.OtherTypeParam _, _ ->
      fail ()

and m_type_parameter_classic a b =
  match (a, b) with
  | ( {
        G.tp_id = a1;
        tp_attrs = a2;
        tp_bounds = a3;
        tp_default = a4;
        tp_variance = a5;
      },
      {
        B.tp_id = b1;
        tp_attrs = b2;
        tp_bounds = b3;
        tp_default = b4;
        tp_variance = b5;
      } ) ->
      let* () = m_ident a1 b1 in
      let* () = m_attributes a2 b2 in
      m_list__m_type_any_order a3 b3 >>= fun () ->
      (m_option m_type_) a4 b4 >>= fun () ->
      (* less-is-more: *)
      let* () = m_option_none_can_match_some (m_wrap m_variance) a5 b5 in
      return ()

and m_variance a b =
  match (a, b) with
  | Covariant, Covariant -> return ()
  | Contravariant, Contravariant -> return ()
  | Covariant, _
  | Contravariant, _ ->
      fail ()

(* ------------------------------------------------------------------------- *)
(* Function (or method) definition *)
(* ------------------------------------------------------------------------- *)
and m_function_kind a b =
  if a =*= b then return ()
  else
    (* iso: we don't care if it's a Function or Arrow *)
    if_config (fun x -> x.arrow_is_function) ~then_:(return ()) ~else_:(fail ())

and m_function_definition a b =
  Trace_matching.(if on then print_function_definition_pair a b);
  match (a, b) with
  | ( { G.fparams = a1; frettype = a2; fbody = a3; fkind = a4 },
      { B.fparams = b1; frettype = b2; fbody = b3; fkind = b4 } ) ->
      m_parameters a1 b1 >>= fun () ->
      (m_option_none_can_match_some m_type_) a2 b2 >>= fun () ->
      m_function_body a3 b3 >>= fun () -> m_wrap m_function_kind a4 b4

and m_function_body a b =
  match (a, b) with
  | G.FBStmt a1, B.FBStmt b1 -> m_block a1 b1
  (* TODO: equivalence: do magic conversion to FStmt? *)
  | G.FBExpr a1, B.FBExpr b1 -> m_expr a1 b1
  | G.FBDecl a1, B.FBDecl b1 -> m_tok a1 b1
  | G.FBNothing, B.FBNothing -> return ()
  (* DEBT: right now we still use FBStmt [] to encode an FBNothing
   * in ast_js.ml, and other languages, so we temporary allow
   * those empty body to match an FBNothing that was generated
   * in Visitor_AST.v_def_as_partial of the target.
   *)
  | G.FBStmt { s = G.Block (_, [], _); _ }, B.FBNothing -> return ()
  | G.FBStmt _, _
  | G.FBExpr _, _
  | G.FBDecl _, _
  | G.FBNothing, _ ->
      fail ()

and m_parameters a b = m_bracket m_parameter_list a b

and m_parameter_list a b =
  m_list_with_dots_and_metavar_ellipsis ~f:m_parameter
    ~is_dots:(function
      | G.ParamEllipsis _ -> true
      | _ -> false)
    ~less_is_ok:false (* empty list can not match non-empty list *)
    ~is_metavar_ellipsis:(function
      | Param { pname = Some (s, tok); _ } when Mvar.is_metavar_ellipsis s ->
          Some ((s, tok), fun xs -> MV.Params xs)
      | _ -> None)
    a b

and m_parameter a b =
  match (a, b) with
  (* Only match a metavariable unconditionally if it has no other characteristics than
     being a metavariable.
     Otherwise, we might match and not check that things like types or default
     instantiation are the same.
     Decided not to match ParamRest and ParamHashSplat, and ParamEllipsis, which
     don't behave like "singular" params.
  *)
  | ( G.Param
        ({
           pname = Some (str, tok);
           ptype = None;
           pdefault = None;
           pattrs = [];
           pinfo = _;
         } as a1),
      b )
    when Mvar.is_metavar_name str -> (
      match b with
      | OtherParam _
      | ParamPattern _
      | ParamReceiver _ ->
          envf (str, tok) (MV.Params [ b ])
      (* We want to first match in the same way `m_parameter_classic` would,
         to maintain previous behavior.
         If there are no matches, then we can just unconditionally match.
      *)
      | Param b1 ->
          m_parameter_classic a1 b1 >!> fun () ->
          envf (str, tok) (MV.Params [ b ])
      | ParamRest _
      | ParamHashSplat _
      | ParamEllipsis _ ->
          fail ())
  (* boilerplate *)
  | G.Param a1, B.Param b1 -> m_parameter_classic a1 b1
  | G.ParamRest (a1, a2), B.ParamRest (b1, b2) ->
      let* () = m_tok a1 b1 in
      m_parameter_classic a2 b2
  | G.ParamHashSplat (a1, a2), B.ParamHashSplat (b1, b2) ->
      let* () = m_tok a1 b1 in
      m_parameter_classic a2 b2
  | G.ParamPattern a1, B.ParamPattern b1 -> m_pattern a1 b1
  | G.ParamReceiver a1, B.ParamReceiver b1 -> m_parameter_classic a1 b1
  | G.OtherParam (a1, a2), B.OtherParam (b1, b2) ->
      m_todo_kind a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.ParamEllipsis a1, B.ParamEllipsis b1 -> m_tok a1 b1
  | G.Param _, _
  | G.ParamPattern _, _
  | G.ParamRest _, _
  | G.ParamHashSplat _, _
  | G.ParamEllipsis _, _
  | G.ParamReceiver _, _
  | G.OtherParam _, _ ->
      fail ()

and m_parameter_classic a b =
  match (a, b) with
  (* bugfix: when we use a metavar to match a parameter, as in foo($X): ...
   * and later we use $X again to match a name, the $X is first an ident and
   * later an expression, which would prevent a match. Instead we need to
   * make $X an expression early on
   *)
  | ( { G.pname = Some a1; pdefault = a2; ptype = a3; pattrs = a4; pinfo = a5 },
      { B.pname = Some b1; pdefault = b2; ptype = b3; pattrs = b4; pinfo = b5 }
    ) ->
      m_ident_and_id_info (a1, a5) (b1, b5) >>= fun () ->
      (m_option_none_can_match_some m_expr) a2 b2 >>= fun () ->
      (m_type_option_with_hook b1) a3 b3 >>= fun () ->
      m_list_in_any_order ~less_is_ok:true m_attribute a4 b4
  (* boilerplate *)
  | ( { G.pname = a1; pdefault = a2; ptype = a3; pattrs = a4; pinfo = a5 },
      { B.pname = b1; pdefault = b2; ptype = b3; pattrs = b4; pinfo = b5 } ) ->
      (m_option m_ident) a1 b1 >>= fun () ->
      (m_option m_expr) a2 b2 >>= fun () ->
      (m_option_none_can_match_some m_type_) a3 b3 >>= fun () ->
      m_list_in_any_order ~less_is_ok:true m_attribute a4 b4 >>= fun () ->
      m_id_info a5 b5

(* ------------------------------------------------------------------------- *)
(* Variable definition *)
(* ------------------------------------------------------------------------- *)
and m_variable_definition a b =
  match (a, b) with
  (* boilerplate *)
  | ( { G.vinit = a1; vtype = a2; vtok = _a3 },
      { B.vinit = b1; vtype = b2; vtok = _b3 } ) ->
      let* () = (m_option m_expr) a1 b1 in
      let* () = (m_option_none_can_match_some m_type_) a2 b2 in
      return ()

(* ------------------------------------------------------------------------- *)
(* Field definition and use *)
(* ------------------------------------------------------------------------- *)

(* As opposed to statements, the order of fields should not matter.
 *
 * We actually filter the '...' and use a less-is-ok approach.
 * Indeed '...' are not really useful, and in some patological cases they
 * were actually leading to the use a tons of memory. Indeed, in certain
 * files containing a long list of fields (like 3000 static fields),
 * the classic use of >||> to handle Ellipsis variations were stressing
 * a lot the engine. Simpler to just filter them.
 *)
and m_fields (xsa : G.field list) (xsb : G.field list) =
  let has_ellipsis = ref false in
  (* let's filter the '...' *)
  let xsa =
    (* TODO: Similar to has_ellipsis_and_filter_ellipsis, refactor? *)
    xsa
    |> List_.exclude (function
         | G.F { s = G.ExprStmt ({ e = G.Ellipsis _; _ }, _); _ } ->
             has_ellipsis := true;
             true
         | _ -> false)
  in
  if_config
    (fun x -> x.implicit_ellipsis)
    ~then_:(m_list__m_field ~less_is_ok:true xsa xsb)
    ~else_:(m_list__m_field ~less_is_ok:!has_ellipsis xsa xsb)

(* less: mix of m_list_and_dots and m_list_unordered_keys, hard to factorize *)
and m_list__m_field ~less_is_ok (xsa : G.field list) (xsb : G.field list) =
  Log.debug (fun m ->
      m "%s"
        (spf "m_list__m_field:%d vs %d" (List.length xsa) (List.length xsb)));
  match (xsa, xsb) with
  | [], [] -> return ()
  (* less-is-ok:
   * it's ok to have fields after in the concrete code as long as we
   * matched all the fields in the pattern.
   *)
  | [], _ :: _ -> if less_is_ok then return () else fail ()
  | G.F { s = G.ExprStmt ({ e = G.Ellipsis _; _ }, _); _ } :: _, _ ->
      raise Impossible
  (* Note that we restrict the match-a-field-at-any-position only for
   * definitions, which allows us to optimize things a little bit
   * by using split_when below.
   * However, if the field use a metavariable, we need to use
   * the more expensive all_elem_and_rest_of_list (see "general case" below).
   *
   * bugfix: In python we used to not do this match-a-field-at-any-pos
   * for code like 'class $FOO: $VAR = 1' because those were originally
   * not parsed as DefStmt but as Assign.
   * alt: keep them as Assign, but always do the all_elem_and_rest_of_list
   *)
  | ( G.F
        {
          s = G.DefStmt (({ G.name = G.EN (G.Id ((s1, _), _)); _ }, _) as adef);
          _;
        }
      :: xsa,
      xsb )
    when (not (Mvar.is_metavar_name s1)) && not (Pattern.is_regexp_string s1)
    -> (
      try
        let before, there, after =
          xsb
          |> Common2.split_when (function
               | G.F
                   {
                     s =
                       G.DefStmt ({ B.name = B.EN (B.Id ((s2, _tok), _)); _ }, _);
                     _;
                   }
                 when s2 = s1 ->
                   true
               | _ -> false)
        in
        match there with
        | G.F { s = G.DefStmt bdef; _ } ->
            m_definition adef bdef >>= fun () ->
            m_list__m_field ~less_is_ok xsa (before @ after)
        | _ -> raise Impossible
      with
      | Not_found -> fail ())
  (* the general case *)
  (* This applies to definitions where the field name is a metavariable,
   * and to any other non-def kind of field (e.g., FieldSpread for `...x` in JS).
   *)
  | a :: xsa, xsb ->
      let candidates = all_elem_and_rest_of_list xsb in
      (* less: could use a fold *)
      let rec aux xs =
        match xs with
        | [] -> fail ()
        | (b, xsb) :: xs ->
            m_field a b
            >>= (fun () ->
                  m_list__m_field ~less_is_ok xsa (lazy_rest_of_list xsb))
            >||> aux xs
      in
      aux candidates

and m_field a b =
  match (a, b) with
  (* boilerplate *)
  | G.F a1, B.F b1 -> m_stmt a1 b1

(* ------------------------------------------------------------------------- *)
(* Type definition *)
(* ------------------------------------------------------------------------- *)
and m_type_definition a b =
  match (a, b) with
  | { G.tbody = a1 }, { B.tbody = b1 } -> m_type_definition_kind a1 b1

and m_type_definition_kind a b =
  match (a, b) with
  | G.OrType a1, B.OrType b1 ->
      m_list_with_dots m_or_type
        (function
          | G.OrEllipsis _ -> true
          | _else_ -> false)
        ~less_is_ok:false a1 b1
  | G.AndType a1, B.AndType b1 -> m_bracket m_fields a1 b1
  | G.AliasType a1, B.AliasType b1 -> m_type_ a1 b1
  | G.NewType a1, B.NewType b1 -> m_type_ a1 b1
  | G.Exception (a1, a2), B.Exception (b1, b2) ->
      m_ident a1 b1 >>= fun () ->
      (* TODO: m_list__m_type_ ? *)
      (m_list m_type_) a2 b2
  | G.OtherTypeKind (a1, a2), B.OtherTypeKind (b1, b2) ->
      m_todo_kind a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.AbstractType a1, B.AbstractType b1 -> m_tok a1 b1
  | G.OrType _, _
  | G.AndType _, _
  | G.AliasType _, _
  | G.Exception _, _
  | G.NewType _, _
  | G.AbstractType _, _
  | G.OtherTypeKind _, _ ->
      fail ()

and m_or_type a b =
  match (a, b) with
  | G.OrConstructor (a1, a2), B.OrConstructor (b1, b2) ->
      m_ident a1 b1 >>= fun () ->
      (* TODO: m_list__m_type_ ? *)
      (m_list m_type_) a2 b2
  | G.OrEnum (a1, a2), B.OrEnum (b1, b2) ->
      m_ident a1 b1 >>= fun () -> m_option m_expr a2 b2
  | G.OrUnion (a1, a2), B.OrUnion (b1, b2) ->
      m_ident a1 b1 >>= fun () -> m_type_ a2 b2
  (* dots: *)
  | G.OrEllipsis _, _ -> return ()
  | G.OrConstructor _, _
  | G.OrEnum _, _
  | G.OrUnion _, _ ->
      fail ()

and _m_list__m_type_ (xsa : G.type_ list) (xsb : G.type_ list) =
  m_list_with_dots m_type_
    (* dots: '...', this is very Python Specific I think *)
      (function
      | { t = G.TyEllipsis _; _ } -> true
      | { t = G.TyExpr { G.e = G.Ellipsis _i; _ }; _ } -> true
      | _ -> false)
      (* less-is-ok: it's ok to not specify all the parents I think *)
    ~less_is_ok:true xsa xsb

and m_list__m_type_any_order (xsa : G.type_ list) (xsb : G.type_ list) =
  (* TODO? filter existing ellipsis?
   * let _has_ellipsis, xsb = has_ellipsis_and_filter_ellipsis xsb in *)
  (* always implicit ... *)
  m_list_in_any_order ~less_is_ok:true m_type_ xsa xsb

and m_list__m_class_parent (xsa : G.class_parent list)
    (xsb : G.class_parent list) =
  with_lang (fun lang ->
      if
        lang =*= Lang.Kotlin
        (* in Kotlin the order in cextends does not matter *)
      then m_list_in_any_order ~less_is_ok:true m_class_parent xsa xsb
      else
        (* we could generalize to other languages, but we currently get
         * regressions for python where the order does seem to matter
         *)
        m_list_with_dots m_class_parent
          (function
            | { G.t = G.TyEllipsis _; _ }, None -> true
            (* dots: '...', this is very Python Specific I think *)
            | { G.t = G.TyExpr { e = G.Ellipsis _i; _ }; _ }, None -> true
            | _ -> false)
            (* less-is-ok: it's ok to not specify all the parents I think *)
          ~less_is_ok:true xsa xsb)

and m_class_parent_basic (a1, a2) (b1, b2) =
  let* () = m_type_ a1 b1 in
  (* less: m_option_none_can_match_some? *)
  let* () = m_option m_arguments a2 b2 in
  return ()

and m_class_parent a b =
  m_class_parent_basic a b >!> (* less: could be >||> *)
                           fun () ->
  match (a, b) with
  (* less: this could be generalized, but let's go simple first *)
  | (a1, None), ({ t = B.TyN (B.Id (id, { id_resolved; _ })); _ }, None) ->
      let xs =
        match !id_resolved with
        | Some (B.ImportedEntity canonical, _sid) ->
            G.canonical_to_dotted (snd id) canonical
        | _ -> [ id ]
      in
      (* deep: *)
      let candidates =
        match !hook_find_possible_parents with
        | None -> []
        | Some f -> f xs
      in
      (* less: use a fold *)
      let rec aux xs =
        match xs with
        | [] -> fail ()
        | x :: xs ->
            let t = B.TyN x |> B.t in
            m_type_ a1 t >||> aux xs
      in
      aux candidates
  | _ -> fail ()

(* ------------------------------------------------------------------------- *)
(* Class definition *)
(* ------------------------------------------------------------------------- *)
(* TODO: there are a few remaining m_list m_type_ we could transform
 * to use instead m_list__m_type_, for Exception, TyTuple and OrConstructor
 * but maybe quite different from list of types in inheritance
 *)
and m_class_definition a b =
  Trace_matching.(if on then print_class_definition_pair a b);
  match (a, b) with
  | ( {
        G.ckind = a1;
        cextends = a2;
        cimplements = a3;
        cmixins = a5;
        cbody = a4;
        cparams = a6;
      },
      {
        B.ckind = b1;
        cextends = b2;
        cimplements = b3;
        cmixins = b5;
        cbody = b4;
        cparams = b6;
      } ) ->
      m_class_kind a1 b1 >>= fun () ->
      m_list__m_class_parent a2 b2 >>= fun () ->
      m_list__m_type_any_order a3 b3 >>= fun () ->
      m_list__m_type_any_order a5 b5 >>= fun () ->
      m_parameters a6 b6 >>= fun () -> m_bracket m_fields a4 b4

and m_class_kind a b = m_wrap m_class_kind_bis a b

and m_class_kind_bis a b =
  match (a, b) with
  | G.Class, B.Class
  | G.Interface, B.Interface
  | G.Trait, B.Trait
  | G.Object, B.Object ->
      return ()
  | G.Class, _
  | G.Interface, _
  | G.Trait, _
  | G.Object, _ ->
      fail ()

(* ------------------------------------------------------------------------- *)
(* Module definition *)
(* ------------------------------------------------------------------------- *)
and m_module_definition a b =
  match (a, b) with
  | { G.mbody = a1 }, { B.mbody = b1 } -> m_module_definition_kind a1 b1

and m_module_definition_kind a b =
  match (a, b) with
  | G.ModuleAlias a1, B.ModuleAlias b1 -> m_dotted_name a1 b1
  | G.ModuleStruct (a1, a2), B.ModuleStruct (b1, b2) ->
      let* () = (m_option m_dotted_name) a1 b1 in
      (* similar to the Block vs Block case *)
      m_stmts_deep ~inside:false ~less_is_ok:false a2 b2
  | G.OtherModule (a1, a2), B.OtherModule (b1, b2) ->
      m_todo_kind a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.ModuleAlias _, _
  | G.ModuleStruct _, _
  | G.OtherModule _, _ ->
      fail ()

(* ------------------------------------------------------------------------- *)
(* Macro definition *)
(* ------------------------------------------------------------------------- *)
and m_macro_definition a b =
  match (a, b) with
  | ( { G.macroparams = a1; macrobody = a2 },
      { B.macroparams = b1; macrobody = b2 } ) ->
      (m_list m_ident) a1 b1 >>= fun () -> (m_list m_any) a2 b2

(*****************************************************************************)
(* Directives (Module import/export, macros) *)
(*****************************************************************************)
and m_directive a b =
  Trace_matching.(if on then print_directive_pair a b);
  let* () =
    m_list_in_any_order ~less_is_ok:true m_attribute a.d_attrs b.d_attrs
  in

  m_directive_basic a.d b.d >!> fun () ->
  match a.d with
  (* normalize only if very simple import pattern (no aliases) *)
  | G.ImportFrom (_, _, imports)
    when List.for_all
           (function
             (* None here means that there is no local alias for the imported
              * name. *)
             | _imported_name, None -> true
             | _imported_name, Some _aliases -> false)
           imports ->
      m_normalized_imports a.d b.d
  | G.ImportAs (_, _, None) -> m_normalized_imports a.d b.d
  (* more complex pattern should not be normalized *)
  | G.ImportFrom _
  | G.ImportAs _
  (* definitely do not normalize the pattern for ImportAll *)
  | G.ImportAll _
  | G.Package _
  | G.PackageEnd _
  | G.Pragma _
  | G.OtherDirective _ ->
      fail ()

(* JS has two standards for importing and exporting values between modules. Rule
 * writers want to avoid this complexity. So, we would like ES6 import patterns
 * (e.g. "import {x} from 'y';") to match CommonJS requires (e.g.
 * "const {x} = require('y');").
 *
 * We used to desugar requires, in some cases, to `ImportFrom` nodes. However,
 * to allow e.g. `$F(...)` to match `require('y')`, and because there is not a
 * one-to-one mapping to from `require` to `import`, we didn't replace the
 * `require` nodes with the `ImportFrom` but instead added the `ImportFrom`.
 *
 * Having two places where the same symbol was defined complicated downstream
 * analysis. See https://github.com/semgrep/semgrep/pull/6532 for some
 * of the issues that it caused.
 *
 * So, in order to simplify naming and maintain the existing matching behavior,
 * we have to explicitly match certain import directives against certain
 * definition statements.
 * *)
and m_directive_vs_def a b =
  let f filea importsa =
    match (importsa, b) with
    (* Pattern: `import 'y';` or `import {} from 'y'`
     *
     * Target: `const x = require('y');` (or var, or let) *)
    | ( [],
        ( { B.name = B.EN (B.Id (_id, _id_info)); _ },
          B.VarDef
            {
              vinit =
                Some
                  {
                    e =
                      B.Call
                        ( { e = B.IdSpecial (B.Require, _); _ },
                          ( _,
                            [ B.Arg { e = B.L (B.String (_, fileb, _)); _ } ],
                            _ ) );
                    _;
                  };
              _;
            } ) ) ->
        (* Match the pattern `import "foo"` against `const x = require("foo")` *)
        m_wrap m_string filea fileb
    (* Pattern: `import {...} from 'y'`
     *
     * Target: const {x, y} = require('z'); (or var, or let) *)
    | ( importsa,
        ( { B.name = B.EN (B.Id ((id_str, _), _)); _ },
          B.VarDef
            {
              vinit =
                Some
                  {
                    e =
                      B.Assign
                        ( { e = B.Record (_, fields, _); _ },
                          _,
                          {
                            e =
                              B.Call
                                ( { e = B.IdSpecial (Require, _); _ },
                                  ( _,
                                    [
                                      B.Arg
                                        { e = B.L (B.String (_, fileb, _)); _ };
                                    ],
                                    _ ) );
                            _;
                          } );
                    _;
                  };
              _;
            } ) )
      when id_str = B.special_multivardef_pattern ->
        let* () = m_wrap m_string filea fileb in
        m_list_in_any_order ~less_is_ok:true m_import_vs_field importsa fields
    | _ -> fail ()
  in
  with_lang (fun lang ->
      (* This construct is specific to JS. We also want to be able to run TS rules
       * against JS targets, though, so we enable this behavior for TS as well.
       *
       * TODO incorporate TS's `import x = require('y')` syntax? *)
      if lang =*= Lang.Js || lang =*= Lang.Ts then
        match a.d with
        (* JS: `import {x, y as z} from 'a';` *)
        | G.ImportFrom (_, G.FileName filea, importsa) -> f filea importsa
        (* JS: `import 'a';` *)
        | G.ImportAs (_, G.FileName filea, None) -> f filea []
        | _ -> fail ()
      else fail ())

(* This is specific to JS/TS. See m_directive_vs_def. *)
and m_import_vs_field a b =
  match (a, b) with
  | ( (ida, aliasa),
      B.F
        {
          s =
            DefStmt
              ( { name = EN (Id (idb, _)); attrs = []; tparams = None },
                FieldDefColon { vinit = Some { e = N (Id (aliasb, _)); _ }; _ }
              );
          _;
        } ) -> (
      let* () = m_ident ida idb in
      match aliasa with
      | None -> m_ident ida aliasb
      | Some (aliasa, _) -> m_ident aliasa aliasb)
  | _ -> fail ()

(* less-is-ok: a few of these below with the use of m_module_name_prefix and
 * m_option_none_can_match_some.
 * todo? not sure it makes sense to always allow m_module_name_prefix below
 *)
and m_directive_basic a b =
  match (a, b) with
  (* metavar: import $LIB should bind $LIB to the full qualified name *)
  (* TODO Should we handle imports with multiple imported names here? Which
   * import would the metavar bind to? *)
  | ( G.ImportFrom (a0, DottedName [], [ ((str, tok), a3) ]),
      B.ImportFrom (b0, DottedName xs, [ (x, b3) ]) )
    when Mvar.is_metavar_name str ->
      let name = H.name_of_ids (xs @ [ x ]) in
      let* () = m_tok a0 b0 in
      let* () = envf (str, tok) (MV.N name) in
      (m_option_none_can_match_some m_ident_and_id_info) a3 b3
  | G.ImportFrom (a0, a1, a2), B.ImportFrom (b0, b1, b2) ->
      m_tok a0 b0 >>= fun () ->
      m_module_name_prefix a1 b1 >>= fun () ->
      let f (x1, x2) (y1, y2) =
        m_ident_and_empty_id_info x1 y1 >>= fun () ->
        (m_option_none_can_match_some m_ident_and_id_info) x2 y2
      in
      m_list_in_any_order ~less_is_ok:true f a2 b2
  | G.ImportAs (a0, a1, a2), B.ImportAs (b0, b1, b2) ->
      m_tok a0 b0 >>= fun () ->
      m_module_name_prefix a1 b1 >>= fun () ->
      (m_option_none_can_match_some m_ident_and_id_info) a2 b2
  | G.ImportAll (a0, a1, a2), B.ImportAll (b0, b1, b2) ->
      m_tok a0 b0 >>= fun () ->
      m_module_name_prefix a1 b1 >>= fun () -> m_tok a2 b2
  (* boilerplate *)
  | G.Package (a0, a1), B.Package (b0, b1) ->
      m_tok a0 b0 >>= fun () -> m_dotted_name a1 b1
  | G.PackageEnd a1, B.PackageEnd b1 -> m_tok a1 b1
  | G.Pragma (a1, a2), B.Pragma (b1, b2) ->
      m_ident a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.OtherDirective (a1, a2), B.OtherDirective (b1, b2) ->
      m_todo_kind a1 b1 >>= fun () -> (m_list m_any) a2 b2
  | G.ImportFrom _, _
  | G.ImportAs _, _
  | G.OtherDirective _, _
  | G.Pragma _, _
  | G.ImportAll _, _
  | G.Package _, _
  | G.PackageEnd _, _ ->
      fail ()

and m_normalized_imports a b =
  (* equivalence: *)
  let normal_as = Normalize_generic.normalize_import_opt true a in
  let normal_bs = Normalize_generic.normalize_import_opt false b in
  match (normal_as, normal_bs) with
  | Some (a0, a1), Some (b0, b1) ->
      m_tok a0 b0 >>= fun () ->
      m_list_in_any_order ~less_is_ok:true m_module_name_prefix a1 b1
  | _ -> fail ()

(*****************************************************************************)
(* Toplevel *)
(*****************************************************************************)
and m_item a b = m_stmt a b

and m_program a b =
  match (a, b) with
  | a, b -> (m_list m_item) a b

(*****************************************************************************)
(* Any *)
(*****************************************************************************)
and m_partial a b =
  match (a, b) with
  | G.PartialDef a1, B.PartialDef b1 -> m_definition a1 b1
  | G.PartialIf (a1, a2), B.PartialIf (b1, b2) ->
      let* () = m_tok a1 b1 in
      m_expr a2 b2
  | G.PartialMatch (a1, a2), B.PartialMatch (b1, b2) ->
      let* () = m_tok a1 b1 in
      m_expr a2 b2
  | G.PartialTry (a1, a2), B.PartialTry (b1, b2) ->
      let* () = m_tok a1 b1 in
      m_stmt a2 b2
  | G.PartialFinally (a1, a2), B.PartialFinally (b1, b2) ->
      let* () = m_tok a1 b1 in
      m_stmt a2 b2
  | G.PartialCatch a1, B.PartialCatch b1 -> m_catch a1 b1
  | G.PartialSingleField (a1, a2, a3), B.PartialSingleField (b1, b2, b3) ->
      let* () = m_ident a1 b1 in
      let* () = m_tok a2 b2 in
      m_expr a3 b3
  | G.PartialLambdaOrFuncDef a1, B.PartialLambdaOrFuncDef b1 ->
      m_function_definition a1 b1
  | G.PartialSwitchCase a1, B.PartialSwitchCase b1 -> m_case_and_body a1 b1
  | G.PartialDef _, _
  | G.PartialIf _, _
  | G.PartialMatch _, _
  | G.PartialTry _, _
  | G.PartialCatch _, _
  | G.PartialFinally _, _
  | G.PartialSingleField _, _
  | G.PartialLambdaOrFuncDef _, _
  | G.PartialSwitchCase _, _ ->
      fail ()

and m_any a b =
  match (a, b) with
  | G.Raw a1, B.Raw b1 -> m_raw_tree a1 b1
  | G.Str (_, a1, _), B.Str (_, b1, _) ->
      m_string_ellipsis_or_metavar_or_default a1 b1
  | G.Ss a1, B.Ss b1 -> m_stmts_deep ~inside:false ~less_is_ok:true a1 b1
  | G.Flds a1, B.Flds b1 -> m_fields a1 b1
  | G.E a1, B.E b1 -> m_expr a1 b1
  | G.S a1, B.S b1 -> m_stmt a1 b1
  | G.Partial a1, B.Partial b1 -> m_partial a1 b1
  | G.Name a1, B.Name b1 -> m_name a1 b1
  | G.Args a1, B.Args b1 -> m_list__m_argument a1 b1
  | G.Params a1, B.Params b1 -> m_list m_parameter a1 b1
  | G.Xmls a1, B.Xmls b1 -> m_list m_xml_body a1 b1
  | G.Anys a1, B.Anys b1 -> m_list m_any a1 b1
  (* boilerplate *)
  | G.Modn a1, B.Modn b1 -> m_module_name a1 b1
  | G.ModDk a1, B.ModDk b1 -> m_module_definition_kind a1 b1
  | G.Tk a1, B.Tk b1 -> m_tok a1 b1
  | G.TodoK a1, B.TodoK b1 -> m_todo_kind a1 b1
  | G.Di a1, B.Di b1 -> m_dotted_name a1 b1
  | G.En a1, B.En b1 -> m_entity a1 b1
  | G.T a1, B.T b1 -> m_type_ a1 b1
  | G.P a1, B.P b1 -> m_pattern a1 b1
  | G.Def a1, B.Def b1 -> m_definition a1 b1
  | G.Dir a1, B.Dir b1 -> m_directive a1 b1
  | G.Fld a1, B.Fld b1 -> m_field a1 b1
  | G.Pa a1, B.Pa b1 -> m_parameter a1 b1
  | G.Ce a1, B.Ce b1 -> m_catch_exn a1 b1
  | G.Cs a1, B.Cs b1 -> m_case a1 b1
  | G.Ar a1, B.Ar b1 -> m_argument a1 b1
  | G.Tp a1, B.Tp b1 -> m_type_parameter a1 b1
  | G.Ta a1, B.Ta b1 -> m_type_argument a1 b1
  | G.At a1, B.At b1 -> m_attribute a1 b1
  | G.XmlAt a1, B.XmlAt b1 -> m_xml_attr a1 b1
  | G.Dk a1, B.Dk b1 -> m_definition_kind a1 b1
  | G.Pr a1, B.Pr b1 -> m_program a1 b1
  | G.I a1, B.I b1 -> m_ident a1 b1
  | G.Lbli a1, B.Lbli b1 -> m_label_ident a1 b1
  | G.ForOrIfComp a1, B.ForOrIfComp b1 -> m_for_or_if_comp a1 b1
  | G.Raw _, _
  | G.I _, _
  | G.Modn _, _
  | G.Di _, _
  | G.En _, _
  | G.E _, _
  | G.S _, _
  | G.T _, _
  | G.P _, _
  | G.Def _, _
  | G.Dir _, _
  | G.Pa _, _
  | G.Ce _, _
  | G.Cs _, _
  | G.Ar _, _
  | G.Tp _, _
  | G.Ta _, _
  | G.At _, _
  | G.XmlAt _, _
  | G.Dk _, _
  | G.Pr _, _
  | G.Fld _, _
  | G.Ss _, _
  | G.Flds _, _
  | G.Tk _, _
  | G.Lbli _, _
  | G.ModDk _, _
  | G.TodoK _, _
  | G.Partial _, _
  | G.Name _, _
  | G.Args _, _
  | G.Params _, _
  | G.Xmls _, _
  | G.ForOrIfComp _, _
  | G.Anys _, _
  | G.Str _, _ ->
      fail ()
